Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • opentrafficshaper/opentrafficshaper
  • eezysol/opentrafficshaper
  • sudesh/opentrafficshaper
  • Yuriy/opentrafficshaper
  • nkukard/opentrafficshaper
  • fcardoso/opentrafficshaper
6 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 3965 additions and 2830 deletions
database/stats.sql
View file @ efc9ebe1
......@@ -5,7 +5,7 @@ DROP TABLE IF EXISTS identifiers;
CREATE TABLE identifiers (
`ID` SERIAL,
`Identifier` VARCHAR(255) NOT NULL
) Engine=MyISAM;
) Engine=InnoDB;
/* For queries */
CREATE INDEX identifiers_idx1 ON identifiers (`Identifier`);
......@@ -28,12 +28,12 @@ CREATE TABLE stats (
`Limit` MEDIUMINT UNSIGNED NOT NULL,
`Rate` MEDIUMINT UNSIGNED NOT NULL,
`PPS` MEDIUMINT UNSIGNED NOT NULL,
`Queue_Len` MEDIUMINT UNSIGNED NOT NULL,
`Total_Bytes` BIGINT UNSIGNED NOT NULL,
`Total_Packets` BIGINT UNSIGNED NOT NULL,
`Total_Overlimits` BIGINT UNSIGNED NOT NULL,
`Total_Dropped` BIGINT UNSIGNED NOT NULL
) Engine=MyISAM;
`QueueLen` MEDIUMINT UNSIGNED NOT NULL,
`TotalBytes` BIGINT UNSIGNED NOT NULL,
`TotalPackets` BIGINT UNSIGNED NOT NULL,
`TotalOverlimits` BIGINT UNSIGNED NOT NULL,
`TotalDropped` BIGINT UNSIGNED NOT NULL
) Engine=InnoDB;
/* For queries */
CREATE INDEX stats_idx1 ON stats (`IdentifierID`);
......@@ -56,7 +56,7 @@ CREATE TABLE stats_basic (
`Timestamp` INTEGER UNSIGNED NOT NULL,
`Counter` BIGINT UNSIGNED NOT NULL
) Engine=MyISAM;
) Engine=InnoDB;
/* For queries */
CREATE INDEX stats_basic_idx1 ON stats (`IdentifierID`);
......
dicts/dictionary
View file @ efc9ebe1
# Basic radius dictionary
# Copyright (C) 2009-2013, AllWorldIT
# Copyright (C) 2009-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
......
dicts/dictionary.allworldit
View file @ efc9ebe1
# AllWorldIT vendor radius dictionary
# Copyright (C) 2009-2013, AllWorldIT
# Copyright (C) 2009-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
......@@ -21,4 +21,5 @@ VENDOR AllWorldIT 42109
ATTRIBUTE OpenTrafficShaper-Traffic-Limit 1 string AllWorldIT
ATTRIBUTE OpenTrafficShaper-Traffic-Group 2 integer AllWorldIT
ATTRIBUTE OpenTrafficShaper-Traffic-Class 3 integer AllWorldIT
ATTRIBUTE OpenTrafficShaper-Traffic-Pool 4 string AllWorldIT
opentrafficshaper.conf
View file @ efc9ebe1
......@@ -19,7 +19,7 @@
# PID file to write our PID to
#
# default:
# pid_file=/var/run/opentrafficshaper/opentrafficshaper.pid
# pid_file=/run/opentrafficshaper/opentrafficshaper.pid
# State file, this file is used to store persistent information
......
opentrafficshaper/POE/Filter/HybridHTTP.pm
View file @ efc9ebe1
# POE::Filter::HybridHTTP - Copyright 2013, AllworldIT
# POE::Filter::HybridHTTP - Copyright 2007-2023, AllworldIT
# Hybrid HTTP filter supporting websockets too.
#
# This program is free software: you can redistribute it and/or modify
......@@ -28,7 +28,7 @@
# and from HTTPD filters, they should submit their request as a patch.
##
package POE::Filter::HybridHTTP;
package opentrafficshaper::POE::Filter::HybridHTTP;
use warnings;
use strict;
......@@ -36,11 +36,11 @@ use strict;
use bytes;
use POE::Filter;
use POE::Filter::HybridHTTP::WebSocketFrame;
use opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame;
use vars qw($VERSION @ISA);
# NOTE - Should be #.### (three decimal places)
$VERSION = '1.100';
$VERSION = '2.000';
@ISA = qw(POE::Filter);
......@@ -65,11 +65,11 @@ my $HTTP_1_1 = _http_version("HTTP/1.1");
# Class instantiation
sub new
sub new
{
my $class = shift;
# These are our internal properties
# These are our internal properties
my $self = { };
# Build our class
bless($self, $class);
......@@ -84,7 +84,7 @@ sub new
# From the docs:
# get_one_start() accepts an array reference containing unprocessed stream chunks. The chunks are added to the filter's Internal
# buffer for parsing by get_one().
sub get_one_start
sub get_one_start
{
my ($self, $stream) = @_;
......@@ -97,7 +97,7 @@ sub get_one_start
# This is called to see if we can grab records/items
sub get_one
sub get_one
{
my $self = shift;
......@@ -109,7 +109,7 @@ sub get_one
# Waiting for content.
} elsif ($self->{'state'} == ST_HTTP_CONTENT) {
return $self->_get_one_http_content();
# Websocket
} elsif ($self->{'state'} == ST_WEBSOCKET_STREAM) {
return $self->_get_one_websocket_record();
......@@ -122,7 +122,7 @@ sub get_one
# Function to push data to the socket
sub put
sub put
{
my ($self, $responses) = @_;
my @results;
......@@ -137,7 +137,7 @@ sub put
# Check if its a websocket upgrade
if (
# Is it a request and do we have a original request?
$h_upgrade eq "websocket" && defined($self->{'last_request'}) &&
$h_upgrade eq "websocket" && defined($self->{'last_request'}) &&
# If so was there a websocket-key?
(my $websocketKey = $self->{'last_request'}->header('Sec-WebSocket-Key'))
) {
......@@ -145,7 +145,7 @@ sub put
# GUID for this protocol as per RFC6455 Section 1.3
my $websocketKeyResponseRaw = $websocketKey."258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
my $websocketKeyResponse = sha1_base64($websocketKeyResponseRaw);
# Pad up to base64 length 4[N/3]
# Pad up to base64 length 4[N/3]
$websocketKeyResponse .= "=" x ((length($websocketKeyResponse) * 3) % 4);
$response->push_header('Sec-WebSocket-Accept',$websocketKeyResponse);
}
......@@ -160,7 +160,7 @@ sub put
foreach my $response (@{$responses}) {
# If we don't have a websocket state, create one
if (!$self->{'websocket_state'}) {
$self->{'websocket_state'} = new POE::Filter::HybridHTTP::WebSocketFrame();
$self->{'websocket_state'} = new opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame();
}
# Don't mask replies from server to client RFC6455 secion 5.1.
$self->{'websocket_state'}->masked(0);
......@@ -201,7 +201,7 @@ sub _reset
# Internal function to parse an HTTP status line and return the HTTP
# protocol version.
sub _http_version
sub _http_version
{
my $version = shift;
......@@ -230,7 +230,7 @@ sub _get_one_http_headers
if ($self->{'buffer'} !~ s/^(\S.*?(?:\r?\n){2})//s) {
return [ ];
}
# Pull the headers as a string off the buffer
# Pull the headers as a string off the buffer
my $header_str = $1;
# Parse the request line.
......@@ -274,7 +274,7 @@ sub _get_one_http_headers
# We no longer matching, so this is the last header?
} else {
last HEADER;
}
}
}
# Push on the last header if we had one...
$request->push_header($key, $val) if $key;
......@@ -288,7 +288,7 @@ sub _get_one_http_headers
$content_length = int($content_length);
}
my $content_encoding = $request->content_encoding();
# The presence of a message-body in a request is signaled by the
# inclusion of a Content-Length or Transfer-Encoding header field in
# the request's message-headers. A message-body MUST NOT be included in
......@@ -322,17 +322,17 @@ sub _get_one_http_headers
# the server SHOULD respond with 400 (bad request) if it cannot
# determine the length of the message, or with 411 (length required) if
# it wishes to insist on receiving a valid Content-Length.
# - RFC2616
# - RFC2616
# PG- This seems to imply that we can either detect the length (but how
# would one do that?) or require a Content-Length header. We do the
# latter.
#
#
# PG- Dispite all the above, I'm not fully sure this implements RFC2616
# properly. There's something about transfer-coding that I don't fully
# understand.
if (!$content_length) {
if (!$content_length) {
# assume a Content-Length of 0 is valid pre 1.1
if ($proto >= $HTTP_1_1 && !defined($content_length)) {
# We have Content-Encoding, but not Content-Length.
......@@ -344,7 +344,7 @@ sub _get_one_http_headers
$self->{'content_length'} = $content_length;
$self->{'state'} = ST_HTTP_CONTENT;
$self->{'request'} = $request;
$self->{'request'} = $request;
$self->_get_one_http_content();
}
......@@ -404,7 +404,7 @@ sub _get_one_websocket_record
# If we don't have a websocket state, create one
if (!$self->{'websocket_state'}) {
$self->{'websocket_state'} = new POE::Filter::HybridHTTP::WebSocketFrame();
$self->{'websocket_state'} = new opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame();
}
$self->{'websocket_state'}->append($self->{'buffer'});
# Blank our buffer
......@@ -480,7 +480,7 @@ sub _build_raw_response
# Set our content length
# - This is required even if the content length is 0, for instance when we doing a REDIRECT with no content some browsers hang if
# - there is no content length set.
$response->push_header("Content-Length",length($response->content));
$response->header("Content-Length" => length($response->content));
# Setup our output
my $output = sprintf("%s %s",$self->{'protocol'},$response->status_line);
......
opentrafficshaper/POE/Filter/HybridHTTP/WebSocketFrame.pm
View file @ efc9ebe1
# POE::Filter::HybridHTTP::WebSocketFrame - Copyright 2013-2014, AllworldIT
# POE::Filter::HybridHTTP::WebSocketFrame - Copyright 2007-2023, AllworldIT
# Hybrid HTTP filter support for WebSocketFrames
#
# This program is free software: you can redistribute it and/or modify
......@@ -33,7 +33,7 @@
# the same terms as Perl 5.10.
##
package POE::Filter::HybridHTTP::WebSocketFrame;
package opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame;
use bytes;
......@@ -110,7 +110,7 @@ sub next {
return Encode::decode('UTF-8', $bytes);
}
return;
return;
}
sub fin { @_ > 1 ? $_[0]->{fin} = $_[1] : $_[0]->{fin} }
......@@ -189,7 +189,7 @@ sub next_bytes {
$offset += 8;
}
# XXX - not sure how to return this sanely
if ($payload_len > $self->{'max_payload_size'}) {
if ($payload_len > $self->{'max_payload_size'}) {
$self->{'buffer'} = '';
return;
}
......
opentrafficshaper/POE/Filter/TCStatistics.pm
View file @ efc9ebe1
# OpenTrafficShaper POE::Filter::TCStatistics TC stats filter
# OpenTrafficShaper webserver module: limits page
# Copyright (C) 2007-2013, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -30,26 +30,27 @@
# and from HTTPD filters, they should submit their request as a patch.
##
package POE::Filter::TCStatistics;
package opentrafficshaper::POE::Filter::TCStatistics;
use warnings;
use strict;
use JSON qw(decode_json);
use POE::Filter;
use vars qw($VERSION @ISA);
# NOTE - Should be #.### (three decimal places)
$VERSION = '1.000';
$VERSION = '3.000';
@ISA = qw(POE::Filter);
# Class instantiation
sub new
sub new
{
my $class = shift;
# These are our internal properties
# These are our internal properties
my $self = { };
# Build our class
bless($self, $class);
......@@ -61,10 +62,11 @@ sub new
}
# From the docs:
# get_one_start() accepts an array reference containing unprocessed stream chunks. The chunks are added to the filter's Internal
# buffer for parsing by get_one().
sub get_one_start
sub get_one_start
{
my ($self, $stream) = @_;
......@@ -76,71 +78,75 @@ sub get_one_start
}
# This is called to see if we can grab records/items
sub get_one
sub get_one
{
my $self = shift;
my @results = ();
# Pull of blocks of class info's
while ($self->{'buffer'} =~ s/^(class.+)\n\s+(.+\n\s+.+)\n.+\n.+\n\n//m) {
my $curstat;
my ($classStr,$statsStr) = ($1,$2);
# Strip off the line into an array
my @classArray = split(/\s+/,$classStr);
my @statsArray = split(/[\s,\(\)]+/,$statsStr);
# Pull in all the items
# class htb 1:1 root rate 100000Kbit ceil 100000Kbit burst 51800b cburst 51800b
if (@classArray == 12) {
$curstat->{'cir'} = _getKNumber($classArray[5]);
$curstat->{'limit'} = _getKNumber($classArray[7]);
# class htb 1:d parent 1:1 rate 10000Kbit ceil 100000Kbit burst 6620b cburst 51800b
} elsif (@classArray == 13) {
$curstat->{'cir'} = _getKNumber($classArray[6]);
$curstat->{'limit'} = _getKNumber($classArray[8]);
# class htb 1:3 parent 1:1 prio 7 rate 10000Kbit ceil 100000Kbit burst 6620b cburst 51800b
} elsif (@classArray == 15) {
$curstat->{'priority'} = int($classArray[6]);
$curstat->{'cir'} = _getKNumber($classArray[8]);
$curstat->{'limit'} = _getKNumber($classArray[10]);
# class htb 1:3 parent 1:1 leaf 3: prio 7 rate 10000Kbit ceil 100000Kbit burst 6620b cburst 51800b
} elsif (@classArray == 17) {
$curstat->{'priority'} = int($classArray[8]);
$curstat->{'cir'} = _getKNumber($classArray[10]);
$curstat->{'limit'} = _getKNumber($classArray[12]);
} else {
next;
}
($curstat->{'_class_parent'},$curstat->{'_class_child'}) = split(/:/,$classArray[2]);
# Sent 0 bytes 0 pkt (dropped 0, overlimits 0 requeues 0)
# rate 0bit 0pps backlog 0b 0p requeues 0
if (@statsArray == 19) {
$curstat->{'total_bytes'} = int($statsArray[1]);
$curstat->{'total_packets'} = int($statsArray[3]);
$curstat->{'total_dropped'} = int($statsArray[6]);
$curstat->{'total_overlimits'} = int($statsArray[8]);
$curstat->{'rate'} = _getKNumber($statsArray[12]);
$curstat->{'pps'} = int(substr($statsArray[13],0,-3));
$curstat->{'queue_size'} = int(substr($statsArray[15],0,-1));
$curstat->{'queue_len'} = int(substr($statsArray[16],0,-1));
} else {
next;
# If we have a empty buffer we can just return
return [] if ($self->{'buffer'} eq '');
chomp($self->{'buffer'});
# NK: It seems we may not get the terminating ] at the end if the output is still busy?
return [] if (substr($self->{'buffer'},-1) ne "]");
# Try decode JSON payload
my $items;
eval {
$items = decode_json($self->{'buffer'});
$self->{'buffer'} = '';
1;
} or do {
print(STDERR "FAILED TO DECODE JSON: >" . $self->{'buffer'} . "<\n");
return [];
};
# Loop with each item and generate a current stat
for my $item (@{$items}) {
my $curstat = {};
# Skip everything except HTB
if ($item->{'class'} ne "htb") {
continue;
}
push(@results,$curstat);
# Split off the handle into the parent and child
( $curstat->{'TCClassParent'}, $curstat->{'TCClassChild'} ) = split( /:/, $item->{'handle'} );
# The rate and ceil is represented in bytes/s, so it needs to be multiplied by 8 and divided by 1000 to get Kbit/s
$curstat->{'CIR'} = (int($item->{'rate'}) * 8) / 1000;
$curstat->{'Limit'} = (int($item->{'ceil'}) * 8) / 1000;
# If we have a prio, we need to add this too
if (defined($item->{'prio'})) {
$curstat->{'Priority'} = int($item->{'prio'});
}
# We should probably always have these
$curstat->{'TotalBytes'} = int($item->{'stats'}->{'bytes'}) // 0;
$curstat->{'TotalPackets'} = int($item->{'stats'}->{'packets'}) // 0;
$curstat->{'TotalDropped'} = int($item->{'stats'}->{'drops'}) // 0;
$curstat->{'TotalOverLimits'} = int($item->{'stats'}->{'overlimits'}) // 0;
$curstat->{'QueueSize'} = int( $item->{'stats'}->{'backlog'} ) // 0;
$curstat->{'QueueLen'} = int( $item->{'stats'}->{'qlen'} ) // 0;
# These are HTB specific if stats are enabled
$curstat->{'Rate'} = 0;
if (defined($item->{'stats'}->{'rate'})) {
$curstat->{'Rate'} = (int($item->{'stats'}->{'rate'}) * 8) / 1000;
}
$curstat->{'PPS'} = 0;
if (defined($item->{'stats'}->{'pps'})) {
$curstat->{'PPS'} = int($item->{'stats'}->{'pps'});
}
push(@results,$curstat);
}
return [ @results ];
}
# Function to push data to the socket
sub put
sub put
{
my ($self, $data) = @_;
......@@ -166,6 +172,7 @@ sub _reset
}
# Get rate...
sub _getKNumber
{
......@@ -179,9 +186,9 @@ sub _getKNumber
} elsif ($multiplier eq "K") {
# noop
} elsif ($multiplier eq "M") {
$num *= 1000000;
$num *= 1000;
} elsif ($multiplier eq "G") {
$num *= 1000000000;
$num *= 1000000;
}
return int($num);
......
awitpt @ 932340ef
Subproject commit 932340ef7336dc40bdd3d35d2023bde1310e9066
opentrafficshaper/constants.pm
View file @ efc9ebe1
# OpenTrafficShaper constants package
# Copyright (C) 2013-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......
opentrafficshaper/logger.pm
View file @ efc9ebe1
# Logging functionality
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -49,6 +49,7 @@ use IO::Handle;
use POSIX qw( strftime );
# Instantiate
sub new {
my ($class) = @_;
......@@ -60,6 +61,8 @@ sub new {
return $self;
}
# Logging function
sub log
{
......@@ -97,6 +100,8 @@ sub log
}
}
# Set log file & open it
sub open
{
......@@ -113,6 +118,8 @@ sub open
$self->{'handle'} = $fh;
}
# Set log level
sub setLevel
{
......@@ -123,5 +130,7 @@ sub setLevel
$self->{'level'} = $level;
}
1;
# vim: ts=4
opentrafficshaper/plugins.pm
View file @ efc9ebe1
# OpenTrafficShaper Plugin Handler
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -38,6 +38,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
my $globals;
# Check if a plugin is loaded
sub isPluginLoaded
{
......@@ -48,6 +49,7 @@ sub isPluginLoaded
}
# Function to register a plugin
sub plugin_register
{
......@@ -80,8 +82,10 @@ sub plugin_register
# Check if the error is critical or not
if ($systemPlugin) {
$logger->log(LOG_ERR,"[PLUGINS] Error loading plugin '%s', things WILL BREAK! (%s)",$pluginName,$@);
exit;
} else {
$logger->log(LOG_WARN,"[PLUGINS] Error loading plugin '%s' (%s)",$pluginName,$@);
exit;
}
} else {
$logger->log(LOG_DEBUG,"[PLUGINS] Plugin '%s' loaded.",$pluginName);
......@@ -90,6 +94,7 @@ sub plugin_register
}
# Setup our main config ref
sub init
{
......@@ -151,5 +156,6 @@ sub _plugin_register {
}
1;
# vim: ts=4
opentrafficshaper/plugins/configmanager.pm
View file @ efc9ebe1
# OpenTrafficShaper configuration manager
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -21,16 +21,29 @@ package opentrafficshaper::plugins::configmanager;
use strict;
use warnings;
use POE;
use Storable qw( dclone );
use Storable qw(
dclone
);
use Time::HiRes qw(
gettimeofday
tv_interval
);
use awitpt::util qw(
isNumber ISNUMBER_ALLOW_ZERO
isUsername ISUSERNAME_ALLOW_ATSIGN
prettyUndef
getHashChanges
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use opentrafficshaper::util qw(
isIPv46 isIPv46CIDR
);
# NK: TODO: Maybe we want to remove timing at some stage? maybe not?
use Time::HiRes qw( gettimeofday tv_interval );
# Exporter stuff
......@@ -40,13 +53,31 @@ our (@ISA,@EXPORT,@EXPORT_OK);
@EXPORT = qw(
);
@EXPORT_OK = qw(
createGroup
isGroupIDValid
createTrafficClass
getTrafficClass
getTrafficClasses
getInterfaceTrafficClass
getAllTrafficClasses
isTrafficClassIDValid
isInterfaceIDValid
createInterface
createInterfaceClass
createInterfaceGroup
changeInterfaceTrafficClass
getEffectiveInterfaceTrafficClass2
isInterfaceTrafficClassValid
setInterfaceTrafficClassShaperState
unsetInterfaceTrafficClassShaperState
createLimit
getLimit
getLimits
getLimitUsername
getOverride
getOverrides
getPoolOverride
getPoolOverrides
createPool
removePool
......@@ -64,6 +95,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
setPoolShaperState
unsetPoolShaperState
isPoolIDValid
isPoolOverridden
isPoolReady
getEffectivePool
......@@ -85,23 +117,14 @@ our (@ISA,@EXPORT,@EXPORT_OK);
removePoolMemberAttribute
isPoolMemberReady
getTrafficClasses
getAllTrafficClasses
getTrafficClassName
isTrafficClassIDValid
getTrafficClassPriority
getTrafficDirection
isInterfaceIDValid
isGroupIDValid
getInterface
getInterfaces
getInterfaceTrafficClasses
getInterfaceDefaultPool
getInterfaceRate
getInterfaceLimit
getInterfaceGroup
getInterfaceGroups
isInterfaceGroupIDValid
......@@ -111,10 +134,10 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.0.1',
VERSION => '1.0.0',
# After how long does a limit get removed if its's deemed offline
TIMEOUT_EXPIRE_OFFLINE => 300,
TIMEOUT_EXPIRE_OFFLINE => 10,
# How often our config check ticks
TICK_PERIOD => 5,
......@@ -130,7 +153,7 @@ sub POOL_REQUIRED_ATTRIBUTES {
qw(
Name
InterfaceGroupID
ClassID TrafficLimitTx TrafficLimitRx
TrafficClassID TxCIR RxCIR
Source
)
}
......@@ -139,7 +162,7 @@ sub POOL_REQUIRED_ATTRIBUTES {
sub POOL_CHANGE_ATTRIBUTES {
qw(
FriendlyName
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
......@@ -152,13 +175,35 @@ sub POOL_PERSISTENT_ATTRIBUTES {
Name
FriendlyName
InterfaceGroupID
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Source
Notes
)
}
# Class attributes that can be changed (overridden)
sub CLASS_CHANGE_ATTRIBUTES {
qw(
CIR Limit
)
}
# Class attributes that can be overidden
sub CLASS_OVERRIDE_CHANGESET_ATTRIBUTES {
qw(
CIR Limit
)
}
# Class attributes that can be overidden
sub CLASS_OVERRIDE_PERSISTENT_ATTRIBUTES {
qw(
InterfaceID
TrafficClassID
CIR Limit
)
}
# Mandatory pool member attributes
sub POOLMEMBER_REQUIRED_ATTRIBUTES {
......@@ -185,6 +230,8 @@ sub POOLMEMBER_PERSISTENT_ATTRIBUTES {
qw(
FriendlyName
Username IPAddress
IPNATAddress
IPNATInbound
MatchPriorityID
PoolID
GroupID
......@@ -201,54 +248,54 @@ sub LIMIT_REQUIRED_ATTRIBUTES {
Username IPAddress
InterfaceGroupID MatchPriorityID
GroupID
ClassID TrafficLimitTx TrafficLimitRx
TrafficClassID TxCIR RxCIR
Source
)
}
# Override match attributes, one is required
sub OVERRIDE_MATCH_ATTRIBUTES {
# Pool override match attributes, one is required
sub POOL_OVERRIDE_MATCH_ATTRIBUTES {
qw(
PoolName Username IPAddress
GroupID
)
}
# Override attributes
sub OVERRIDE_ATTRIBUTES {
# Pool override attributes
sub POOL_OVERRIDE_ATTRIBUTES {
qw(
FriendlyName
PoolName Username IPAddress GroupID
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
}
# Override attributes that can be changed
sub OVERRIDE_CHANGE_ATTRIBUTES {
# Pool override attributes that can be changed
sub POOL_OVERRIDE_CHANGE_ATTRIBUTES {
qw(
FriendlyName
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
}
# Override changeset attributes
sub OVERRIDE_CHANGESET_ATTRIBUTES {
# Pool override changeset attributes
sub POOL_OVERRIDE_CHANGESET_ATTRIBUTES {
qw(
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
)
}
# Override attributes supported for persistent storage
sub OVERRIDE_PERSISTENT_ATTRIBUTES {
# Pool override attributes supported for persistent storage
sub POOL_OVERRIDE_PERSISTENT_ATTRIBUTES {
qw(
FriendlyName
PoolName Username IPAddress GroupID
ClassID TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Notes
Expires Created
Source
......@@ -269,29 +316,13 @@ our $pluginInfo = {
};
# Copy of system globals
# This modules globals
my $globals;
# System logger
my $logger;
# Configuration for this plugin
our $config = {
# Class to use for unclassified traffic
'default_pool' => undef,
# Traffic groups
'groups' => {
1 => 'Default'
},
# Traffic classes
'classes' => {
1 => 'Default'
},
# Interfaces
'interfaces' => {
},
# Interface groups
'interface_groups' => {
},
# Match priorities
'match_priorities' => {
1 => 'First',
......@@ -302,143 +333,202 @@ our $config = {
'statefile' => '/var/lib/opentrafficshaper/configmanager.state',
};
# Last time the cleanup ran
my $lastCleanup = time();
# If our state has changed and when last we sync'd to disk
my $stateChanged = 0;
my $lastStateSync = time();
#
# GROUPS - pool members are linked to groups
#
# Attributes:
# * ID
# * Name
#
# $globals->{'Groups'}
#
# CLASSES
#
# Attributes:
# * ID
# * Name
#
# $globals->{'TrafficClasses'}
#
# INTERFACES
#
my $interfaceIPMap = {};
# Attributes:
# * ID
# * Name
# * Interface
# * Limit
#
# $globals->{'Interfaces'}
#
# POOLS
#
# Parameters:
# * ID
# * FriendlyName
# - Used for display purposes
# - Used for display purposes
# * Name
# - Unix timestamp when this entry expires, 0 if never
# * ClassID
# - Class ID
# - Unix timestamp when this entry expires, 0 if never
# * TrafficClassID
# - Traffic class ID
# * InterfaceGroupID
# - Interface group this pool is attached to
# * TrafficLimitTx
# - Traffic limit in kbps
# * TrafficLimitRx
# - Traffic limit in kbps
# * TrafficLimitTxBurst
# - Traffic bursting limit in kbps
# * TrafficLimitRxBurst
# - Traffic bursting limit in kbps
# - Interface group this pool is attached to
# * TxCIR
# - Traffic limit in kbps
# * RxCIR
# - Traffic limit in kbps
# * TxLimit
# - Traffic bursting limit in kbps
# * RxLimit
# - Traffic bursting limit in kbps
# * Notes
# - Notes on this limit
# - Notes on this limit
# * Source
# - This is the source of the limit, typically plugin.ModuleName
my $pools = { };
my $poolNameMap = { };
my $poolIDCounter = 1;
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'Pools'}
# $globals->{'PoolNameMap'}
# $globals->{'PoolIDCounter'}
#
# POOL MEMBERS
#
# Supoprted user attributes:
# * ID
# * PoolID
# - Pool ID
# - Pool ID
# * Username
# - Users username
# - Users username
# * IPAddress
# - Users IP address
# - Users IP address
# * GroupID
# - Group ID
# - Group ID
# * MatchPriorityID
# - Match priority on the backend of this limit
# * ClassID
# - Class ID
# - Match priority on the backend of this limit
# * TrafficClassID
# - Class ID
# * Expires
# - Unix timestamp when this entry expires, 0 if never
# - Unix timestamp when this entry expires, 0 if never
# * FriendlyName
# - Used for display purposes instead of username if specified
# - Used for display purposes instead of username if specified
# * Notes
# - Notes on this limit
# - Notes on this limit
# * Status
# - new
# - offline
# - online
# - unknown
# - new
# - offline
# - online
# - unknown
# * Source
# - This is the source of the limit, typically plugin.ModuleName
my $poolMembers = { };
my $poolMemberIDCounter = 1;
my $poolMemberMap = { };
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'PoolMembers'}
# $globals->{'PoolMemberIDCounter'}
# $globals->{'PoolMemberMap'}
#
# OVERRIDES
# POOL OVERRIDES
#
# Selection criteria:
# * PoolName
# - Pool name
# - Pool name
# * Username
# - Users username
# - Users username
# * IPAddress
# - Users IP address
# - Users IP address
# * GroupID
# - Group ID
# - Group ID
#
# Overrides:
# * ClassID
# - Class ID
# * TrafficLimitTx
# - Traffic limit in kbps
# * TrafficLimitRx
# - Traffic limit in kbps
# * TrafficLimitTxBurst
# - Traffic bursting limit in kbps
# * TrafficLimitRxBurst
# - Traffic bursting limit in kbps
# Pool Overrides:
# * TrafficClassID
# - Class ID
# * TxCIR
# - Traffic limit in kbps
# * RxCIR
# - Traffic limit in kbps
# * TxLimit
# - Traffic bursting limit in kbps
# * RxLimit
# - Traffic bursting limit in kbps
#
# Parameters:
# * ID
# * FriendlyName
# - Used for display purposes
# - Used for display purposes
# * Expires
# - Unix timestamp when this entry expires, 0 if never
# - Unix timestamp when this entry expires, 0 if never
# * Notes
# - Notes on this limit
# - Notes on this limit
# * Source
# - This is the source of the limit, typically plugin.ModuleName
my $overrides = { };
my $overrideIDCounter = 1;
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'PoolOverrides'}
# $globals->{'PoolOverrideIDCounter'}
# Global change queues
my $poolChangeQueue = { };
my $poolMemberChangeQueue = { };
#
# CHANGE QUEUES
#
# $globals->{'PoolChangeQueue'}
# $globals->{'PoolMemberChangeQueue'}
# Initialize plugin
sub plugin_init
{
$globals = shift;
my $system = shift;
my $now = time();
# Setup our environment
$logger = $globals->{'logger'};
$logger = $system->{'logger'};
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] OpenTrafficShaper Config Manager v%s - Copyright (c) 2007-2014, AllWorldIT",
VERSION
);
# Initialize
$globals->{'LastCleanup'} = $now;
$globals->{'StateChanged'} = 0;
$globals->{'LastStateSync'} = $now;
$globals->{'Groups'} = { };
$globals->{'TrafficClasses'} = { };
$globals->{'Interfaces'} = { };
$globals->{'InterfaceGroups'} = { };
$globals->{'Pools'} = { };
$globals->{'PoolNameMap'} = { };
$globals->{'PoolIDCounter'} = 1;
$globals->{'DefaultPool'} = undef;
$globals->{'PoolMembers'} = { };
$globals->{'PoolMemberIDCounter'} = 1;
$globals->{'PoolMemberMap'} = { };
$globals->{'PoolOverrides'} = { };
$globals->{'PoolOverrideIDCounter'} = 1;
$globals->{'InterfaceTrafficClasses'} = { };
$globals->{'InterfaceTrafficClassCounter'} = 1;
$globals->{'PoolChangeQueue'} = { };
$globals->{'PoolMemberChangeQueue'} = { };
$globals->{'InterfaceTrafficClassChangeQueue'} = { };
# If we have global config, use it
my $gconfig = { };
if (defined($globals->{'file.config'}->{'shaping'})) {
$gconfig = $globals->{'file.config'}->{'shaping'};
if (defined($system->{'file.config'}->{'shaping'})) {
$gconfig = $system->{'file.config'}->{'shaping'};
}
# Split off groups to load
......@@ -469,8 +559,15 @@ sub plugin_init
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic group definition '%s' has invalid name, ignoring",$group);
next;
}
$config->{'groups'}->{$groupID} = $groupName;
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic group '%s' with ID %s.",$groupName,$groupID);
# Create group
$groupID = createGroup({
'ID' => $groupID,
'Name' => $groupName
});
if (defined($groupID)) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic group '%s' [%s]",$groupName,$groupID);
}
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Traffic groups loaded");
......@@ -494,8 +591,8 @@ sub plugin_init
# Skip comments
next if ($class =~ /^\s*#/);
# Split off class ID and class name
my ($classID,$className) = split(/:/,$class);
if (!defined(isNumber($classID))) {
my ($trafficClassID,$className) = split(/:/,$class);
if (!defined(isNumber($trafficClassID))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic class definition '%s' has invalid ID, ignoring",$class);
next;
}
......@@ -503,8 +600,17 @@ sub plugin_init
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic class definition '%s' has invalid name, ignoring",$class);
next;
}
$config->{'classes'}->{$classID} = $className;
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic class '%s' with ID %s",$className,$classID);
# Create class
$trafficClassID = createTrafficClass({
'ID' => $trafficClassID,
'Name' => $className
});
if (!defined($trafficClassID)) {
next;
}
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic class '%s' [%s]",$className,$trafficClassID);
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Traffic classes loaded");
......@@ -512,8 +618,8 @@ sub plugin_init
# Load interfaces
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading interfaces...");
my @interfaces;
if (defined($globals->{'file.config'}->{'shaping.interface'})) {
@interfaces = keys %{$globals->{'file.config'}->{'shaping.interface'}};
if (defined($system->{'file.config'}->{'shaping.interface'})) {
@interfaces = keys %{$system->{'file.config'}->{'shaping.interface'}};
} else {
@interfaces = ( "eth0", "eth1" );
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No interfaces defined, using 'eth0' and 'eth1'");
......@@ -523,37 +629,45 @@ sub plugin_init
# This is the interface config to make things easier for us
my $iconfig = { };
# Check if its defined
if (defined($globals->{'file.config'}->{'shaping.interface'}) &&
defined($globals->{'file.config'}->{'shaping.interface'}->{$interface})
if (defined($system->{'file.config'}->{'shaping.interface'}) &&
defined($system->{'file.config'}->{'shaping.interface'}->{$interface})
) {
$iconfig = $globals->{'file.config'}->{'shaping.interface'}->{$interface}
$iconfig = $system->{'file.config'}->{'shaping.interface'}->{$interface}
}
# Check our friendly name for this interface
my $interfaceName = "$interface (auto)";
if (defined($iconfig->{'name'}) && $iconfig->{'name'} ne "") {
$config->{'interfaces'}->{$interface}->{'name'} = $iconfig->{'name'};
$interfaceName = $iconfig->{'name'};
} else {
$config->{'interfaces'}->{$interface}->{'name'} = "$interface (auto)";
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' has no 'name' attribute, using '%s (auto)'",
$interface,$interface
);
}
# Check our interface rate
my $interfaceLimit = 100000;
if (defined($iconfig->{'rate'}) && $iconfig->{'rate'} ne "") {
# Check rate is valid
# Check limit is valid
if (defined(my $rate = isNumber($iconfig->{'rate'}))) {
$config->{'interfaces'}->{$interface}->{'rate'} = $rate;
$interfaceLimit = $rate;
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' has invalid 'rate' attribute, using 100000 instead",
$interface
);
}
} else {
$config->{'interfaces'}->{$interface}->{'rate'} = 100000;
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' has no 'rate' attribute specified, using 100000",$interface);
}
# Create interface
my $interfaceID = createInterface({
'ID' => $interface,
'Name' => $interfaceName,
'Device' => $interface,
'Limit' => $interfaceLimit
});
# Check if we have a section in our
if (defined($iconfig->{'class_rate'})) {
......@@ -571,10 +685,10 @@ sub plugin_init
# Skip comments
next if ($iclass =~ /^\s*#/);
# Split off class ID and class name
my ($iclassID,$iclassCIR,$iclassLimit) = split(/[:\/]/,$iclass);
my ($itrafficClassID,$iclassCIR,$iclassLimit) = split(/[:\/]/,$iclass);
if (!defined(isNumber($iclassID))) {
if (!defined($itrafficClassID = isTrafficClassIDValid($itrafficClassID))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class definition '%s' has invalid Class ID, ignoring ".
"definition",
$interface,
......@@ -582,15 +696,6 @@ sub plugin_init
);
next;
}
if (!defined($config->{'classes'}->{$iclassID})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class definition '%s' uses Class ID '%s' which doesn't ".
"exist",
$interface,
$iclass,
$iclassID
);
next;
}
# If the CIR is defined, try use it
if (defined($iclassCIR)) {
......@@ -599,21 +704,21 @@ sub plugin_init
my ($cir,$percent) = ($1,$2);
# Check if this is a percentage or an actual kbps value
if (defined($percent)) {
$iclassCIR = int($config->{'interfaces'}->{$interface}->{'rate'} * ($cir / 100));
$iclassCIR = int($interfaceLimit * ($cir / 100));
} else {
$iclassCIR = $cir;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has invalid CIR, ignoring definition",
$interface,
$iclassID
$itrafficClassID
);
next;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has missing CIR, ignoring definition",
$interface,
$iclassID
$itrafficClassID
);
next;
}
......@@ -625,54 +730,54 @@ sub plugin_init
my ($Limit,$percent) = ($1,$2);
# Check if this is a percentage or an actual kbps value
if (defined($percent)) {
$iclassLimit = int($config->{'interfaces'}->{$interface}->{'rate'} * ($Limit / 100));
$iclassLimit = int($interfaceLimit * ($Limit / 100));
} else {
$iclassLimit = $Limit;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has invalid Limit, ignoring",
$interface,
$iclassID
$itrafficClassID
);
next;
}
} else {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has missing Limit, using CIR '%s' instead",
$interface,
$iclassID,
$itrafficClassID,
$iclassCIR
);
$iclassLimit = $iclassCIR;
}
# Check if rates are below are sane
if ($iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'}) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > interface speed '%s', ".
if ($iclassCIR > $interfaceLimit) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > interface speed '%s', ".
"adjusting to '%s'",
$interface,
$iclassID,
$itrafficClassID,
$iclassCIR,
$iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'},
$iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'}
$interfaceLimit,
$interfaceLimit
);
$iclassCIR = $iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'};
$iclassCIR = $interfaceLimit;
}
if ($iclassLimit > $config->{'interfaces'}->{$interface}->{'rate'}) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has Limit '%s' > interface speed '%s', ".
if ($iclassLimit > $interfaceLimit) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has Limit '%s' > interface speed '%s', ".
"adjusting to '%s'",
$interface,
$iclassID,
$itrafficClassID,
$iclassCIR,
$iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'},
$iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'}
$interfaceLimit,
$interfaceLimit
);
$iclassLimit = $iclassCIR > $config->{'interfaces'}->{$interface}->{'rate'};
$iclassLimit = $interfaceLimit;
}
if ($iclassCIR > $iclassLimit) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > Limit '%s', adjusting CIR ".
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > Limit '%s', adjusting CIR ".
"to '%s'",
$interface,
$iclassID,
$itrafficClassID,
$iclassLimit,
$iclassLimit,
$iclassLimit
......@@ -680,70 +785,86 @@ sub plugin_init
$iclassCIR = $iclassLimit;
}
# Build class config
$config->{'interfaces'}->{$interface}->{'classes'}->{$iclassID} = {
'cir' => $iclassCIR,
'limit' => $iclassLimit
};
# Create class
my $interfaceTrafficClassID = createInterfaceTrafficClass({
'InterfaceID' => $interfaceID,
'TrafficClassID' => $itrafficClassID,
'CIR' => $iclassCIR,
'Limit' => $iclassLimit
});
if (!defined($interfaceTrafficClassID)) {
next;
}
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded interface '%s' class rate for class ID '%s': %s/%s",
$interface,
$iclassID,
$itrafficClassID,
$iclassCIR,
$iclassLimit
);
}
# Time to check the interface classes
foreach my $classID (keys %{$config->{'classes'}}) {
# Check if we have a rate defined for this class in the interface definition
if (!defined($config->{'interfaces'}->{$interface}->{'classes'}->{$classID})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' has no class '%s' defined, using interface limit",
$interface,
$classID
);
$config->{'interfaces'}->{$interface}->{'classes'}->{$classID} = {
'cir' => $config->{'interfaces'}->{$interface}->{'rate'},
'limit' => $config->{'interfaces'}->{$interface}->{'rate'}
};
}
}
}
# Time to check the interface classes
foreach my $trafficClassID (getAllTrafficClasses()) {
# Check if we have a rate defined for this class in the interface definition
if (!isInterfaceTrafficClassValid($interfaceID,$trafficClassID)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' has no class '%s' defined, using interface limit",
$interface,
$trafficClassID
);
# Create the default class
createInterfaceTrafficClass({
'InterfaceID' => $interfaceID,
'TrafficClassID' => $trafficClassID,
'CIR' => $interfaceLimit,
'Limit' => $interfaceLimit
});
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded interface '%s' default class rate for class ID '%s': %s/%s",
$interface,
$trafficClassID,
$interfaceLimit,
$interfaceLimit
);
}
}
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading interfaces completed");
# Pull in interface groupings
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading interface groups...");
# Check if we loaded an array or just text
my @interfaceGroups;
my @cinterfaceGroups;
if (defined($gconfig->{'interface_group'})) {
if (ref($gconfig->{'interface_group'}) eq "ARRAY") {
@interfaceGroups = @{$gconfig->{'interface_group'}};
@cinterfaceGroups = @{$gconfig->{'interface_group'}};
} else {
@interfaceGroups = ( $gconfig->{'interface_group'} );
@cinterfaceGroups = ( $gconfig->{'interface_group'} );
}
} else {
@interfaceGroups = ( "eth1,eth0:Default" );
@cinterfaceGroups = ( "eth1,eth0:Default" );
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No interface groups, trying default eth1,eth0");
}
# Loop with interface groups
foreach my $interfaceGroup (@interfaceGroups) {
foreach my $interfaceGroup (@cinterfaceGroups) {
# Skip comments
next if ($interfaceGroup =~ /^\s*#/);
# Split off class ID and class name
my ($txiface,$rxiface,$friendlyName) = split(/[:,]/,$interfaceGroup);
if (!defined($config->{'interfaces'}->{$txiface})) {
my ($txInterface,$rxInterface,$friendlyName) = split(/[:,]/,$interfaceGroup);
if (!isInterfaceIDValid($txInterface)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface group definition '%s' has invalid interface '%s', ignoring",
$interfaceGroup,
$txiface
$txInterface
);
next;
}
if (!defined($config->{'interfaces'}->{$rxiface})) {
if (!isInterfaceIDValid($rxInterface)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface group definition '%s' has invalid interface '%s', ignoring",
$interfaceGroup,
$rxiface
$rxInterface
);
next;
}
......@@ -754,25 +875,25 @@ sub plugin_init
next;
}
$config->{'interface_groups'}->{"$txiface,$rxiface"} = {
'name' => $friendlyName,
'txiface' => $txiface,
'rxiface' => $rxiface
};
# Create interface group
my $interfaceGroupID = createInterfaceGroup({
'Name' => $friendlyName,
'TxInterface' => $txInterface,
'RxInterface' => $rxInterface
});
if (!defined($interfaceGroupID)) {
next;
}
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded interface group '%s' with interfaces '%s/%s'",
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded interface group '%s' [%s] with interfaces '%s/%s'",
$friendlyName,
$txiface,
$rxiface
$interfaceGroupID,
$txInterface,
$rxInterface
);
}
# Initialize IP address map
foreach my $interfaceGroupID (keys %{$config->{'interface_groups'}}) {
# Blank interface IP address map for interface group
$interfaceIPMap->{$interfaceGroupID} = { };
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Interface groups loaded");
......@@ -780,12 +901,11 @@ sub plugin_init
if (defined($gconfig->{'default_pool'})) {
# Check if its a number
if (defined(my $default_pool = isNumber($gconfig->{'default_pool'}))) {
if (defined($config->{'classes'}->{$default_pool})) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Default pool set to use class '%s' (%s)",
$default_pool,
$config->{'classes'}->{$default_pool}
if (isTrafficClassIDValid($default_pool)) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Default pool set to use class '%s'",
$default_pool
);
$config->{'default_pool'} = $default_pool;
$globals->{'DefaultPool'} = $default_pool;
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot enable default pool, class '%s' does not exist",
$default_pool
......@@ -797,7 +917,7 @@ sub plugin_init
}
# Check if we have a state file
if (defined(my $statefile = $globals->{'file.config'}->{'system'}->{'statefile'})) {
if (defined(my $statefile = $system->{'file.config'}->{'system'}->{'statefile'})) {
$config->{'statefile'} = $statefile;
$logger->log(LOG_INFO,"[CONFIGMANAGER] Set statefile to '%s'",$statefile);
}
......@@ -812,9 +932,9 @@ sub plugin_init
limit_add => \&_session_limit_add,
override_add => \&_session_override_add,
override_change => \&_session_override_change,
override_remove => \&_session_override_remove,
pool_override_add => \&_session_pool_override_add,
pool_override_change => \&_session_pool_override_change,
pool_override_remove => \&_session_pool_override_remove,
pool_add => \&_session_pool_add,
pool_remove => \&_session_pool_remove,
......@@ -829,6 +949,7 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
......@@ -839,10 +960,10 @@ sub plugin_start
$logger->log(LOG_WARN,"[CONFIGMANAGER] Statefile '%s' cannot be opened: %s",$config->{'statefile'},$!);
}
$logger->log(LOG_INFO,"[CONFIGMANAGER] Started with %s pools, %s pool members and %s overrides",
scalar(keys %{$pools}),
scalar(keys %{$poolMembers}),
scalar(keys %{$overrides})
$logger->log(LOG_INFO,"[CONFIGMANAGER] Started with %s pools, %s pool members and %s pool overrides",
scalar(keys %{$globals->{'Pools'}}),
scalar(keys %{$globals->{'PoolMembers'}}),
scalar(keys %{$globals->{'PoolOverrides'}})
);
}
......@@ -866,6 +987,7 @@ sub _session_start
}
# Stop the session
sub _session_stop
{
......@@ -875,7 +997,7 @@ sub _session_stop
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Shutting down, saving configuration...");
# We only need to write the sate if something changed?
if ($stateChanged) {
if ($globals->{'StateChanged'}) {
# The 1 means FULL WRITE of all entries
_write_statefile(1);
}
......@@ -883,27 +1005,13 @@ sub _session_stop
# Blow away all data
$globals = undef;
$interfaceIPMap = { };
$pools = { };
$poolNameMap = { };
$poolIDCounter = 1;
$poolMembers = { };
$poolMemberIDCounter = 1;
$poolMemberMap = { };
$poolChangeQueue = { };
$poolMemberChangeQueue = { };
# XXX: Blow away rest? config?
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Shutdown");
$logger = undef;
}
# Time ticker for processing changes
sub _session_tick
{
......@@ -913,25 +1021,26 @@ sub _session_tick
my $now = time();
# Check if we should sync state to disk
if ($stateChanged && $lastStateSync + STATE_SYNC_INTERVAL < $now) {
if ($globals->{'StateChanged'} && $globals->{'LastStateSync'} + STATE_SYNC_INTERVAL < $now) {
_write_statefile();
}
# Check if we should cleanup
if ($lastCleanup + CLEANUP_INTERVAL < $now) {
# Loop with all overrides and check for expired entries
while (my ($oid, $override) = each(%{$overrides})) {
# Override has effectively expired
if (defined($override->{'Expires'}) && $override->{'Expires'} > 0 && $override->{'Expires'} < $now) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Override '%s' [%s] has expired, removing",
$override->{'FriendlyName'},
$oid
if ($globals->{'LastCleanup'} + CLEANUP_INTERVAL < $now) {
# Loop with all pool overrides and check for expired entries
while (my ($poid, $poolOverride) = each(%{$globals->{'PoolOverrides'}})) {
# Pool override has effectively expired
if (defined($poolOverride->{'Expires'}) && $poolOverride->{'Expires'} > 0 && $poolOverride->{'Expires'} < $now) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool override '%s' [%s] has expired, removing",
$poolOverride->{'FriendlyName'},
$poid
);
removeOverride($oid);
removePoolOverride($poid);
}
}
# Loop with all pool members and check for expired entries
while (my ($pmid, $poolMember) = each(%{$poolMembers})) {
while (my ($pmid, $poolMember) = each(%{$globals->{'PoolMembers'}})) {
# Pool member has effectively expired
if (defined($poolMember->{'Expires'}) && $poolMember->{'Expires'} > 0 && $poolMember->{'Expires'} < $now) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool member '%s' [%s] has expired, removing",
......@@ -942,7 +1051,7 @@ sub _session_tick
}
}
# Loop with all the pools and check for expired entries
while (my ($pid, $pool) = each(%{$pools})) {
while (my ($pid, $pool) = each(%{$globals->{'Pools'}})) {
# Pool has effectively expired
if (defined($pool->{'Expires'}) && $pool->{'Expires'} > 0 && $pool->{'Expires'} < $now) {
# There are no members, its safe to remove
......@@ -956,12 +1065,46 @@ sub _session_tick
}
}
# Reset last cleanup time
$lastCleanup = $now;
$globals->{'LastCleanup'} = $now;
}
# Loop through interface traffic classes
while (my ($interfaceTrafficClassID, $interfaceTrafficClass) = each(%{$globals->{'InterfaceTrafficClassChangeQueue'}})) {
my $shaperState = getInterfaceTrafficClassShaperState($interfaceTrafficClassID);
# Traffic class has been changed
if ($interfaceTrafficClass->{'Status'} == CFGM_CHANGED) {
# If the shaper is live we can go ahead
if ($shaperState & SHAPER_LIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface traffic class [%s] has been modified, sending to shaper",
$interfaceTrafficClassID
);
$kernel->post('shaper' => 'class_change' => $interfaceTrafficClassID);
# Set pending online
setInterfaceTrafficClassShaperState($interfaceTrafficClassID,SHAPER_PENDING);
$interfaceTrafficClass->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($globals->{'InterfaceTrafficClassChangeQueue'}->{$interfaceTrafficClassID});
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Interface traffic class [%s] has UNKNOWN state '%s'",
$interfaceTrafficClassID,
$shaperState
);
}
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Interface traffic class [%s] has UNKNOWN status '%s'",
$interfaceTrafficClassID,
$interfaceTrafficClass->{'Status'}
);
}
}
# Loop through pool change queue
while (my ($pid, $pool) = each(%{$poolChangeQueue})) {
my $shaperState = getPoolShaperState($pool->{'ID'});
while (my ($pid, $pool) = each(%{$globals->{'PoolChangeQueue'}})) {
my $shaperState = getPoolShaperState($pid);
# Pool is newly added
if ($pool->{'Status'} == CFGM_NEW) {
......@@ -974,10 +1117,10 @@ sub _session_tick
);
$kernel->post('shaper' => 'pool_add' => $pid);
# Set pending online
setPoolShaperState($pool->{'ID'},SHAPER_PENDING);
setPoolShaperState($pid,SHAPER_PENDING);
$pool->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($poolChangeQueue->{$pid});
delete($globals->{'PoolChangeQueue'}->{$pid});
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' [%s] has UNKNOWN state '%s'",
......@@ -1010,7 +1153,6 @@ sub _session_tick
# Pool has been modified
} elsif ($pool->{'Status'} == CFGM_CHANGED) {
# If the shaper is live we can go ahead
if ($shaperState & SHAPER_LIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] has been modified, sending to shaper",
......@@ -1019,10 +1161,10 @@ sub _session_tick
);
$kernel->post('shaper' => 'pool_change' => $pid);
# Set pending online
setPoolShaperState($pool->{'ID'},SHAPER_PENDING);
setPoolShaperState($pid,SHAPER_PENDING);
$pool->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($poolChangeQueue->{$pid});
delete($globals->{'PoolChangeQueue'}->{$pid});
} elsif ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] has been modified and is not live, re-queue as add",
......@@ -1054,7 +1196,7 @@ sub _session_tick
$pid
);
$kernel->post('shaper' => 'pool_remove' => $pid);
setPoolShaperState($pool->{'ID'},SHAPER_PENDING);
setPoolShaperState($pid,SHAPER_PENDING);
} else {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] marked offline, but still has pool members, ".
"aborting remove",
......@@ -1062,7 +1204,7 @@ sub _session_tick
$pid
);
$pool->{'Status'} = CFGM_ONLINE;
delete($poolChangeQueue->{$pid});
delete($globals->{'PoolChangeQueue'}->{$pid});
}
} else {
......@@ -1070,7 +1212,7 @@ sub _session_tick
if (my @poolMembers = getPoolMembers($pid)) {
# Loop with members and remove
foreach my $pmid (@poolMembers) {
my $poolMember = $poolMembers->{$pmid};
my $poolMember = $globals->{'PoolMembers'}->{$pmid};
# Only remove ones online
if ($poolMember->{'Status'} == CFGM_ONLINE) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Pool '%s' [%s] marked offline and not expired, removing ".
......@@ -1091,15 +1233,15 @@ sub _session_tick
$pid
);
# Remove pool from name map
delete($poolNameMap->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}});
delete($globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}});
# Remove pool member mapping
delete($poolMemberMap->{$pool->{'ID'}});
delete($globals->{'PoolMemberMap'}->{$pid});
# Remove from queue
delete($poolChangeQueue->{$pid});
# Cleanup overrides
_override_remove_pool($pool->{'ID'});
delete($globals->{'PoolChangeQueue'}->{$pid});
# Cleanup pool overrides
_remove_pool_override($pid);
# Remove pool
delete($pools->{$pool->{'ID'}});
delete($globals->{'Pools'}->{$pid});
}
} else {
......@@ -1111,17 +1253,18 @@ sub _session_tick
}
}
# Loop through pool member change queue
while (my ($pmid, $poolMember) = each(%{$poolMemberChangeQueue})) {
while (my ($pmid, $poolMember) = each(%{$globals->{'PoolMemberChangeQueue'}})) {
my $pool = $pools->{$poolMember->{'PoolID'}};
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
# We need to skip doing anything until the pool becomes live
if (getPoolShaperState($pool->{'ID'}) & SHAPER_NOTLIVE) {
next;
}
my $shaperState = getPoolMemberShaperState($poolMember->{'ID'});
my $shaperState = getPoolMemberShaperState($pmid);
# Pool member is newly added
if ($poolMember->{'Status'} == CFGM_NEW) {
......@@ -1135,10 +1278,10 @@ sub _session_tick
);
$kernel->post('shaper' => 'poolmember_add' => $pmid);
# Set pending online
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_PENDING);
setPoolMemberShaperState($pmid,SHAPER_PENDING);
$poolMember->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($poolMemberChangeQueue->{$pmid});
delete($globals->{'PoolMemberChangeQueue'}->{$pmid});
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has UNKNOWN state '%s'",
......@@ -1184,10 +1327,10 @@ sub _session_tick
);
$kernel->post('shaper' => 'poolmember_change' => $pmid);
# Set pending online
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_PENDING);
setPoolMemberShaperState($pmid,SHAPER_PENDING);
$poolMember->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($poolMemberChangeQueue->{$pmid});
delete($globals->{'PoolMemberChangeQueue'}->{$pmid});
} elsif ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has been modified and is not live, re-queue as ".
......@@ -1222,7 +1365,7 @@ sub _session_tick
$pmid
);
$kernel->post('shaper' => 'poolmember_remove' => $pmid);
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_PENDING);
setPoolMemberShaperState($pmid,SHAPER_PENDING);
} else {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] marked offline and fresh, postponing",
......@@ -1239,15 +1382,63 @@ sub _session_tick
$pmid
);
# Unlink interface IP address map
delete($interfaceIPMap->{$pool->{'InterfaceGroupID'}}->{$poolMember->{'IPAddress'}}->{$poolMember->{'ID'}});
delete($globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}->{$poolMember->{'IPAddress'}}
->{$pmid});
# Unlink pool map
delete($poolMemberMap->{$pool->{'ID'}}->{$poolMember->{'ID'}});
delete($globals->{'PoolMemberMap'}->{$pool->{'ID'}}->{$pmid});
# Remove from queue
delete($poolMemberChangeQueue->{$pmid});
# We need to re-process the overrides after the member has been removed
_override_resolve([$poolMember->{'PoolID'}]);
delete($globals->{'PoolMemberChangeQueue'}->{$pmid});
# We need to re-process the pool overrides after the member has been removed
_resolve_pool_override([$poolMember->{'PoolID'}]);
# Remove pool member
delete($poolMembers->{$poolMember->{'ID'}});
delete($globals->{'PoolMembers'}->{$pmid});
# Check if we have/had conflicts
if ((my @conflicts = keys
%{$globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}->{$poolMember->{'IPAddress'}}}) > 0)
{
# We can only re-tag a pool member for adding if we have 1 pool member
if (@conflicts == 1) {
# Grab conflicted pool member, its index 0 in the conflicts array
my $cPoolMember = $globals->{'PoolMembers'}->{$conflicts[0]};
my $cPoolMemberShaperState = getPoolMemberShaperState($cPoolMember->{'ID'});
# We only want to work with conflicts
if ($cPoolMemberShaperState & SHAPER_CONFLICT) {
# Grab pool
my $cPool = $globals->{'Pools'}->{$cPoolMember->{'PoolID'}};
# Unset conflict state
unsetPoolMemberShaperState($cPoolMember->{'ID'},SHAPER_CONFLICT);
# Add to change queue
$globals->{'PoolMemberChangeQueue'}->{$cPoolMember->{'ID'}} = $cPoolMember;
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] IP '%s' is no longer conflicted, removing conflict from ".
"pool '%s' member '%s' [%s], was conflicted with pool '%s' member '%s' [%s]",
$cPoolMember->{'IPAddress'},
$cPool->{'Name'},
$cPoolMember->{'Username'},
$cPoolMember->{'ID'},
$pool->{'Name'},
$poolMember->{'Username'},
$poolMember->{'ID'}
);
}
} else {
# Loop wiht conflicts and build some log items to use
my @logItems;
foreach my $pmid (@conflicts) {
my $cPoolMember = $globals->{'PoolMembers'}->{$pmid};
my $cPool = $globals->{'Pools'}->{$cPoolMember->{'PoolID'}};
push(@logItems,sprintf("Pool:%s/Member:%s",$cPool->{'Name'},$cPoolMember->{'Username'}));
}
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] IP '%s' is still in conflict: %s",
$poolMember->{'IPAddress'},
join(", ",@logItems)
);
}
}
}
} else {
......@@ -1266,15 +1457,17 @@ sub _session_tick
}
# Handle SIGHUP
sub _session_SIGHUP
{
my ($kernel, $heap, $signal_name) = @_[KERNEL, HEAP, ARG0];
$logger->log(LOG_WARN,"[CONFIGMANAGER] Got SIGHUP, ignoring for now");
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Got SIGHUP, ignoring for now");
}
# Event for 'pool_add'
sub _session_pool_add
{
......@@ -1282,7 +1475,7 @@ sub _session_pool_add
if (!defined($poolData)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No pool data provided for 'pool_add' event");
$logger->log(LOG_WARN,"[CONFIGMANAGER] No pool data provided for 'pool_add' event");
return;
}
......@@ -1305,6 +1498,7 @@ sub _session_pool_add
}
# Event for 'pool_remove'
sub _session_pool_remove
{
......@@ -1313,7 +1507,7 @@ sub _session_pool_remove
my $pool;
if (!defined(getPool($pid))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_remove' event",prettyUndef($pid));
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_remove' event",prettyUndef($pid));
return;
}
......@@ -1321,6 +1515,7 @@ sub _session_pool_remove
}
# Event for 'pool_change'
sub _session_pool_change
{
......@@ -1328,7 +1523,7 @@ sub _session_pool_change
if (!isPoolIDValid($poolData->{'ID'})) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_change' event",prettyUndef($poolData->{'ID'}));
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_change' event",prettyUndef($poolData->{'ID'}));
return;
}
......@@ -1336,6 +1531,7 @@ sub _session_pool_change
}
# Event for 'poolmember_add'
sub _session_poolmember_add
{
......@@ -1343,7 +1539,7 @@ sub _session_poolmember_add
if (!defined($poolMemberData)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No pool member data provided for 'poolmember_add' event");
$logger->log(LOG_WARN,"[CONFIGMANAGER] No pool member data provided for 'poolmember_add' event");
return;
}
......@@ -1364,192 +1560,666 @@ sub _session_poolmember_add
}
# Event for 'poolmember_remove'
sub _session_poolmember_remove
{
my ($kernel, $pmid) = @_[KERNEL, ARG0];
if (!isPoolMemberIDValid($pmid)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid pool member ID '%s' for 'poolmember_remove' event",prettyUndef($pmid));
if (!isPoolMemberIDValid($pmid)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool member ID '%s' for 'poolmember_remove' event",prettyUndef($pmid));
return;
}
removePoolMember($pmid);
}
# Event for 'poolmember_change'
sub _session_poolmember_change
{
my ($kernel, $poolMemberData) = @_[KERNEL, ARG0];
if (!isPoolMemberIDValid($poolMemberData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool member ID '%s' for 'poolmember_change' event",
prettyUndef($poolMemberData->{'ID'})
);
return;
}
changePoolMember($poolMemberData);
}
# Event for 'limit_add'
sub _session_limit_add
{
my ($kernel, $limitData) = @_[KERNEL, ARG0];
if (!defined($limitData)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] No limit data provided for 'limit_add' event");
return;
}
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (LIMIT_REQUIRED_ATTRIBUTES) {
if (!defined($limitData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as there is an attribute missing: '%s'",$isInvalid);
return;
}
createLimit($limitData);
}
# Event for 'pool_override_add'
sub _session_pool_override_add
{
my ($kernel, $poolOverrideData) = @_[KERNEL, ARG0];
if (!defined($poolOverrideData)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] No pool override data provided for 'pool_override_add' event");
return;
}
# Check that we have at least one match attribute
my $isValid = 0;
foreach my $item (POOL_OVERRIDE_MATCH_ATTRIBUTES) {
$isValid++;
}
if (!$isValid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool override as there is no selection attribute");
return;
}
createPoolOverride($poolOverrideData);
}
# Event for 'pool_override_remove'
sub _session_pool_override_remove
{
my ($kernel, $poid) = @_[KERNEL, ARG0];
if (!isPoolOverrideIDValid($poid)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool override ID '%s' for 'pool_override_remove' event",
prettyUndef($poid)
);
return;
}
removePoolOverride($poid);
}
# Event for 'pool_override_change'
sub _session_pool_override_change
{
my ($kernel, $poolOverrideData) = @_[KERNEL, ARG0];
if (!isPoolOverrideIDValid($poolOverrideData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool override ID '%s' for 'pool_override_change' event",
prettyUndef($poolOverrideData->{'ID'})
);
return;
}
changePoolOverride($poolOverrideData);
}
# Function to create a group
sub createGroup
{
my $groupData = shift;
my $group;
# Check if ID is valid
if (!defined($group->{'ID'} = $groupData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add group as ID is invalid");
return;
}
# Check if Name is valid
if (!defined($group->{'Name'} = $groupData->{'Name'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add group as Name is invalid");
return;
}
# Add pool
$globals->{'Groups'}->{$group->{'ID'}} = $group;
return $group->{'ID'};
}
# Function to check the group ID exists
sub isGroupIDValid
{
my $gid = shift;
if (!defined($globals->{'Groups'}->{$gid})) {
return;
}
return $gid;
}
# Function to create a traffic class
sub createTrafficClass
{
my $classData = shift;
my $class;
# Check if ID is valid
if (!defined($class->{'ID'} = $classData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add traffic class as ID is invalid");
return;
}
# Check if Name is valid
if (!defined($class->{'Name'} = $classData->{'Name'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add traffic class as Name is invalid");
return;
}
# Add pool
$globals->{'TrafficClasses'}->{$class->{'ID'}} = $class;
return $class->{'ID'};
}
# Function to get traffic classes
sub getTrafficClasses
{
my @trafficClasses = ( );
# Loop with traffic classes
foreach my $trafficClassID (keys %{$globals->{'TrafficClasses'}}) {
# Skip over default pool if we have one
if (defined($globals->{'DefaultPool'}) && $trafficClassID eq $globals->{'DefaultPool'}) {
next;
}
# Add to class list
push (@trafficClasses,$trafficClassID);
}
return @trafficClasses;
}
# Function to get a interface traffic class
sub getInterfaceTrafficClass
{
my ($interfaceID,$trafficClassID) = @_;
# Check if this interface ID is valid
if (!isInterfaceIDValid($interfaceID)) {
return;
}
# Check if traffic class ID is valid
if (!defined($trafficClassID = isNumber($trafficClassID,ISNUMBER_ALLOW_ZERO))) {
return;
}
if ($trafficClassID && !isTrafficClassIDValid($trafficClassID)) {
return;
}
my $interfaceTrafficClass = dclone($globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{$trafficClassID});
# Check if the traffic class ID is not 0
if ($trafficClassID) {
$interfaceTrafficClass->{'Name'} = $globals->{'TrafficClasses'}->{$trafficClassID}->{'Name'};
# If if it 0, this is a root class
} else {
$interfaceTrafficClass->{'Name'} = "Root Class";
}
delete($interfaceTrafficClass->{'.applied_overrides'});
return $interfaceTrafficClass;
}
# Function to get a interface traffic class
sub getInterfaceTrafficClass2
{
my $interfaceTrafficClassID = shift;
# Check if this interface ID is valid
if (!isInterfaceTrafficClassIDValid2($interfaceTrafficClassID)) {
return;
}
my $interfaceTrafficClass = dclone($globals->{'InterfaceTrafficClasses'}->{$interfaceTrafficClassID});
$interfaceTrafficClass->{'Name'} = $globals->{'TrafficClasses'}->{$interfaceTrafficClass->{'TrafficClassID'}};
delete($interfaceTrafficClass->{'.applied_overrides'});
return $interfaceTrafficClass;
}
# Function to check if traffic class is valid
sub isInterfaceTrafficClassValid
{
my ($interfaceID,$trafficClassID) = @_;
if (
!defined($interfaceID) || !defined($trafficClassID) ||
!defined($globals->{'Interfaces'}->{$interfaceID}) ||
!defined($globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{$trafficClassID})
) {
return;
}
return $globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{$trafficClassID}->{'ID'};
}
# Function to check the interface traffic class ID is valid
sub isInterfaceTrafficClassIDValid2
{
my $interfaceTrafficClassID = shift;
if (
!defined($interfaceTrafficClassID) ||
!defined($globals->{'InterfaceTrafficClasses'}->{$interfaceTrafficClassID})
) {
return;
}
return $interfaceTrafficClassID;
}
# Function to create an interface class
sub createInterfaceTrafficClass
{
my $interfaceTrafficClassData = shift;
my $interfaceTrafficClass;
# Check if InterfaceID is valid
if (!defined($interfaceTrafficClass->{'InterfaceID'} = isInterfaceIDValid($interfaceTrafficClassData->{'InterfaceID'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface traffic class as InterfaceID is invalid");
return;
}
# Check if traffic class ID is valid
my $interfaceTrafficClassID;
if (!defined($interfaceTrafficClassID = isNumber($interfaceTrafficClassData->{'TrafficClassID'},ISNUMBER_ALLOW_ZERO))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process class change as there is no 'TrafficClassID' attribute");
return;
}
if ($interfaceTrafficClassID && !isTrafficClassIDValid($interfaceTrafficClassData->{'TrafficClassID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process class change as 'TrafficClassID' attribute is invalid");
return;
}
$interfaceTrafficClass->{'TrafficClassID'} = $interfaceTrafficClassID;
# Check CIR is valid
if (!defined($interfaceTrafficClass->{'CIR'} = isNumber($interfaceTrafficClassData->{'CIR'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as CIR is invalid");
return;
}
# Check Limit is valid
if (!defined($interfaceTrafficClass->{'Limit'} = isNumber($interfaceTrafficClassData->{'Limit'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as Limit is invalid");
return;
}
# Set ID
$interfaceTrafficClass->{'ID'} = $globals->{'InterfaceTrafficClassCounter'}++;
# Set status
$interfaceTrafficClass->{'Status'} = CFGM_NEW;
# Add interface
$globals->{'Interfaces'}->{$interfaceTrafficClass->{'InterfaceID'}}->{'TrafficClasses'}
->{$interfaceTrafficClass->{'TrafficClassID'}} = $interfaceTrafficClass;
# Link to interface traffic classes
$globals->{'InterfaceTrafficClasses'}->{$interfaceTrafficClass->{'ID'}} = $interfaceTrafficClass;
# TODO: Hack, this should set NOTLIVE & NEW and have the shaper create as per note in plugin_init section
# Set status on this interface traffic class
setInterfaceTrafficClassShaperState($interfaceTrafficClass->{'ID'},SHAPER_LIVE);
$interfaceTrafficClass->{'Status'} = CFGM_ONLINE;
return $interfaceTrafficClass->{'TrafficClassID'};
}
# Function to change a traffic class
sub changeInterfaceTrafficClass
{
my $interfaceTrafficClassData = shift;
# Check interface exists first
my $interfaceID;
if (!defined($interfaceID = isInterfaceIDValid($interfaceTrafficClassData->{'InterfaceID'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process interface class change as there is no 'InterfaceID' attribute");
return;
}
# Check if traffic class ID is valid
my $trafficClassID;
if (!defined($trafficClassID = isNumber($interfaceTrafficClassData->{'TrafficClassID'},ISNUMBER_ALLOW_ZERO))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process class change as there is no 'TrafficClassID' attribute");
return;
}
if ($trafficClassID && !isTrafficClassIDValid($interfaceTrafficClassData->{'TrafficClassID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process class change as 'TrafficClassID' attribute is invalid");
return;
}
my $interfaceTrafficClass = $globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{$trafficClassID};
my $changes = getHashChanges($interfaceTrafficClass,$interfaceTrafficClassData,[CLASS_CHANGE_ATTRIBUTES]);
# Bump up changes
$globals->{'StateChanged'}++;
# Flag changed
$interfaceTrafficClass->{'Status'} = CFGM_CHANGED;
# XXX - hack our override in
$interfaceTrafficClass->{'.applied_overrides'}->{'change'} = $changes;
# Add to change queue
$globals->{'InterfaceTrafficClassChangeQueue'}->{$interfaceTrafficClass->{'ID'}} = $interfaceTrafficClass;
# Return what was changed
return dclone($changes);
}
# Function to return a class with any items changed as per class overrides
sub getEffectiveInterfaceTrafficClass2
{
my $interfaceTrafficClassID = shift;
my $interfaceTrafficClass;
if (!defined($interfaceTrafficClass = getInterfaceTrafficClass2($interfaceTrafficClassID))) {
return;
}
my $realInterfaceTrafficClass = $globals->{'InterfaceTrafficClasses'}->{$interfaceTrafficClassID};
# If we have applied class overrides, check out what changes there may be
if (defined(my $appliedClassOverrides = $realInterfaceTrafficClass->{'.applied_overrides'})) {
my $interfaceTrafficClassOverrideSet;
# Loop with class overrides in ascending fashion, least matches to most
foreach my $interfaceTrafficClassID (
sort { $appliedClassOverrides->{$a} <=> $appliedClassOverrides->{$b} } keys %{$appliedClassOverrides}
) {
my $interfaceTrafficClassOverride = $appliedClassOverrides->{$interfaceTrafficClassID};
# Loop with attributes and create our override set
foreach my $attr (CLASS_OVERRIDE_CHANGESET_ATTRIBUTES) {
# Set class override set attribute if the class override has defined it
if (defined($interfaceTrafficClassOverride->{$attr}) && $interfaceTrafficClassOverride->{$attr} ne "") {
$interfaceTrafficClassOverrideSet->{$attr} = $interfaceTrafficClassOverride->{$attr};
}
}
}
# Set class overrides on pool
if (defined($interfaceTrafficClassOverrideSet)) {
foreach my $attr (keys %{$interfaceTrafficClassOverrideSet}) {
$interfaceTrafficClass->{$attr} = $interfaceTrafficClassOverrideSet->{$attr};
}
}
}
return $interfaceTrafficClass;
}
# Function to set interface traffic class shaper state
sub setInterfaceTrafficClassShaperState
{
my ($interfaceTrafficClassID,$state) = @_;
# Check interface traffic class exists first
if (!isInterfaceTrafficClassIDValid2($interfaceTrafficClassID)) {
return;
}
$globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'} |= $state;
return $globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'};
}
# Function to unset interface traffic class shaper state
sub unsetInterfaceTrafficClassShaperState
{
my ($interfaceTrafficClassID,$state) = @_;
# Check interface traffic class exists first
if (!isInterfaceTrafficClassIDValid2($interfaceTrafficClassID)) {
return;
}
removePoolMember($pmid);
$globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'} &= ~$state;
return $globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'};
}
# Event for 'poolmember_change'
sub _session_poolmember_change
# Function to get shaper state for a interface traffic class
sub getInterfaceTrafficClassShaperState
{
my ($kernel, $poolMemberData) = @_[KERNEL, ARG0];
my $interfaceTrafficClassID = shift;
if (!isPoolMemberIDValid($poolMemberData->{'ID'})) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid pool member ID '%s' for 'poolmember_change' event",
prettyUndef($poolMemberData->{'ID'})
);
# Check interface traffic class exists first
if (!isInterfaceTrafficClassIDValid2($interfaceTrafficClassID)) {
return;
}
changePoolMember($poolMemberData);
return $globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'};
}
# Event for 'limit_add'
sub _session_limit_add
# Function to get all traffic classes
sub getAllTrafficClasses
{
my ($kernel, $limitData) = @_[KERNEL, ARG0];
return ( keys %{$globals->{'TrafficClasses'}} );
}
if (!defined($limitData)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No limit data provided for 'limit_add' event");
return;
}
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (LIMIT_REQUIRED_ATTRIBUTES) {
if (!defined($limitData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as there is an attribute missing: '%s'",$isInvalid);
# Function to get a traffic class
sub getTrafficClass
{
my $trafficClassID = shift;
if (!isTrafficClassIDValid($trafficClassID)) {
return;
}
createLimit($limitData);
return $globals->{'TrafficClasses'}->{$trafficClassID};
}
# Event for 'override_add'
sub _session_override_add
{
my ($kernel, $overrideData) = @_[KERNEL, ARG0];
# Function to check if traffic class is valid
sub isTrafficClassIDValid
{
my $trafficClassID = shift;
if (!defined($overrideData)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No override data provided for 'override_add' event");
return;
}
# Check that we have at least one match attribute
my $isValid = 0;
foreach my $item (OVERRIDE_MATCH_ATTRIBUTES) {
$isValid++;
}
if (!$isValid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process override as there is no selection attribute");
if (!defined($trafficClassID) || !defined($globals->{'TrafficClasses'}->{$trafficClassID})) {
return;
}
createOverride($overrideData);
return $trafficClassID;
}
# Event for 'override_remove'
sub _session_override_remove
# Function to return the traffic priority based on a traffic class
sub getTrafficClassPriority
{
my ($kernel, $oid) = @_[KERNEL, ARG0];
my $trafficClassID = shift;
if (!isOverrideIDValid($oid)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid override ID '%s' for 'override_remove' event",prettyUndef($oid));
# Check it exists first
if (!isTrafficClassIDValid($trafficClassID)) {
return;
}
removeOverride($oid);
# NK: Short circuit, our TrafficClassID = Priority
return $trafficClassID;
}
# Event for 'override_change'
sub _session_override_change
# Function to create an interface
sub createInterface
{
my ($kernel, $overrideData) = @_[KERNEL, ARG0];
my $interfaceData = shift;
if (!isOverrideIDValid($overrideData->{'ID'})) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Invalid override ID '%s' for 'override_change' event",
prettyUndef($overrideData->{'ID'})
);
my $interface;
# Check if ID is valid
if (!defined($interface->{'ID'} = $interfaceData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as ID is invalid");
return;
}
changeOverride($overrideData);
}
# Check if Interface is valid
if (!defined($interface->{'Device'} = $interfaceData->{'Device'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as Device is invalid");
return;
}
# Check if Name is valid
if (!defined($interface->{'Name'} = $interfaceData->{'Name'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as Name is invalid");
return;
}
# Function to check the group ID exists
sub isGroupIDValid
{
my $gid = shift;
# Check Limit is valid
if (!defined($interface->{'Limit'} = isNumber($interfaceData->{'Limit'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface as Limit is invalid");
return;
}
# Add interface
$globals->{'Interfaces'}->{$interface->{'ID'}} = $interface;
if (defined($config->{'groups'}->{$gid})) {
return $gid;
}
# Create interface main traffic class
createInterfaceTrafficClass({
'InterfaceID' => $interface->{'ID'},
'TrafficClassID' => 0,
'CIR' => $interfaceData->{'Limit'},
'Limit' => $interfaceData->{'Limit'},
});
return;
return $interface->{'ID'};
}
# Function to return if an interface ID is valid
sub isInterfaceIDValid
{
my $iid = shift;
my $interfaceID = shift;
# Return undef if interface is not valid
if (!defined($config->{'interfaces'}->{$iid})) {
if (!defined($globals->{'Interfaces'}->{$interfaceID})) {
return;
}
return $iid;
return $interfaceID;
}
# Function to return the configured Interfaces
sub getInterfaces
{
return [ keys %{$config->{'interfaces'}} ];
return ( keys %{$globals->{'Interfaces'}} );
}
# Return interface classes
sub getInterface
{
my $iid = shift;
my $interfaceID = shift;
# If we have this interface return its classes
if (!isInterfaceIDValid($iid)) {
# Check if interface ID is valid
if (!isInterfaceIDValid($interfaceID)) {
return;
}
my $res = dclone($config->{'interfaces'}->{$iid});
# We don't really want to return classes
delete($res->{'classes'});
my $res = dclone($globals->{'Interfaces'}->{$interfaceID});
# We don't want to return TrafficClasses
delete($res->{'TrafficClasses'});
# And return it...
return $res;
}
# Return interface traffic classes
sub getInterfaceTrafficClasses
{
my $iid = shift;
# If we have this interface return its classes
if (!isInterfaceIDValid($iid)) {
return;
}
return dclone($config->{'interfaces'}->{$iid}->{'classes'});
}
# Function to return our default pool configuration
sub getInterfaceDefaultPool
......@@ -1558,60 +2228,88 @@ sub getInterfaceDefaultPool
# We don't really need the interface to return the default pool
return $config->{'default_pool'};
return $globals->{'DefaultPool'};
}
# Function to return interface rate
sub getInterfaceRate
# Function to create an interface group
sub createInterfaceGroup
{
my $iid = shift;
my $interfaceGroupData = shift;
my $interfaceGroup;
# If we have this interface return its classes
if (!isInterfaceIDValid($iid)) {
# Check if Name is valid
if (!defined($interfaceGroup->{'Name'} = $interfaceGroupData->{'Name'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface group as Name is invalid");
return;
}
return $config->{'interfaces'}->{$iid}->{'rate'};
# Check if TxInterface is valid
if (!defined($interfaceGroup->{'TxInterface'} = isInterfaceIDValid($interfaceGroupData->{'TxInterface'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface group as TxInterface is invalid");
return;
}
# Check if RxInterface is valid
if (!defined($interfaceGroup->{'RxInterface'} = isInterfaceIDValid($interfaceGroupData->{'RxInterface'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to add interface group as RxInterface is invalid");
return;
}
$interfaceGroup->{'ID'} = sprintf('%s,%s',$interfaceGroup->{'TxInterface'},$interfaceGroup->{'RxInterface'});
$interfaceGroup->{'IPMap'} = { };
# Add interface group
$globals->{'InterfaceGroups'}->{$interfaceGroup->{'ID'}} = $interfaceGroup;
return $interfaceGroup->{'ID'};
}
# Function to get interface groups
sub getInterfaceGroups
{
my $interface_groups = dclone($config->{'interface_groups'});
return $interface_groups;
return ( keys %{$globals->{'InterfaceGroups'}} );
}
# Function to check if interface group is valid
sub isInterfaceGroupIDValid
# Function to get an interface group
sub getInterfaceGroup
{
my $igid = shift;
my $interfaceGroupID = shift;
if (!defined($igid) || !defined($config->{'interface_groups'}->{$igid})) {
if (!isInterfaceGroupIDValid($interfaceGroupID)) {
return;
}
return $igid;
my $interfaceGroup = dclone($globals->{'InterfaceGroups'}->{$interfaceGroupID});
delete($interfaceGroup->{'IPMap'});
return $interfaceGroup;
}
# Function to get an interface group
sub getInterfaceGroup
# Function to check if interface group is valid
sub isInterfaceGroupIDValid
{
my $igid = shift;
my $interfaceGroupID = shift;
if (!isInterfaceGroupIDValid($igid)) {
if (!defined($interfaceGroupID) || !defined($globals->{'InterfaceGroups'}->{$interfaceGroupID})) {
return;
}
return dclone($config->{'interface_groups'}->{$igid});
return $interfaceGroupID;
}
......@@ -1622,6 +2320,7 @@ sub getMatchPriorities
}
# Function to check if interface group is valid
sub isMatchPriorityIDValid
{
......@@ -1637,6 +2336,7 @@ sub isMatchPriorityIDValid
}
# Function to set a pool attribute
sub setPoolAttribute
{
......@@ -1648,12 +2348,13 @@ sub setPoolAttribute
return;
}
$pools->{$pid}->{'.attributes'}->{$attr} = $value;
$globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr} = $value;
return $value;
}
# Function to get a pool attribute
sub getPoolAttribute
{
......@@ -1666,14 +2367,18 @@ sub getPoolAttribute
}
# Check if attribute exists first
if (!defined($pools->{$pid}->{'.attributes'}) || !defined($pools->{$pid}->{'.attributes'}->{$attr})) {
if (
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}) ||
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr}))
{
return;
}
return $pools->{$pid}->{'.attributes'}->{$attr};
return $globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr};
}
# Function to remove a pool attribute
sub removePoolAttribute
{
......@@ -1686,37 +2391,43 @@ sub removePoolAttribute
}
# Check if attribute exists first
if (!defined($pools->{$pid}->{'.attributes'}) || !defined($pools->{$pid}->{'.attributes'}->{$attr})) {
if (
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}) ||
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr}))
{
return;
}
return delete($pools->{$pid}->{'.attributes'}->{$attr});
return delete($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr});
}
# Function to return a override
sub getOverride
# Function to return a pool override
sub getPoolOverride
{
my $oid = shift;
my $poid = shift;
if (!isOverrideIDValid($oid)) {
if (!isPoolOverrideIDValid($poid)) {
return;
}
my $override = dclone($overrides->{$oid});
my $poolOverride = dclone($globals->{'PoolOverrides'}->{$poid});
return $override;
return $poolOverride;
}
## Function to return a list of override ID's
sub getOverrides
## Function to return a list of pool override ID's
sub getPoolOverrides
{
return (keys %{$overrides});
return (keys %{$globals->{'PoolOverrides'}});
}
# Function to create a pool
sub createPool
{
......@@ -1745,55 +2456,55 @@ sub createPool
# Now check if the name is valid
if (!defined($pool->{'Name'} = $poolData->{'Name'})) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool add as Name is invalid");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add as Name is invalid");
return;
}
# Check interface group ID is OK
if (!defined($pool->{'InterfaceGroupID'} = isInterfaceGroupIDValid($poolData->{'InterfaceGroupID'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool add for '%s' as the InterfaceGroupID is invalid",
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the InterfaceGroupID is invalid",
$pool->{'Name'}
);
return;
}
# If we already have this name added, return it as the pool
if (defined(my $pool = $poolNameMap->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}})) {
if (defined(my $pool = $globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}})) {
return $pool->{'ID'};
}
# Check class is OK
if (!defined($pool->{'ClassID'} = isTrafficClassIDValid($poolData->{'ClassID'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool add for '%s' as the ClassID is invalid",
if (!defined($pool->{'TrafficClassID'} = isTrafficClassIDValid($poolData->{'TrafficClassID'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the TrafficClassID is invalid",
$pool->{'Name'}
);
return;
}
# Make sure things are not attached to the default pool
if (defined($config->{'default_pool'}) && $pool->{'ClassID'} eq $config->{'default_pool'}) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the ClassID is the 'default_pool' ClassID",
if (defined($globals->{'DefaultPool'}) && $pool->{'TrafficClassID'} eq $globals->{'DefaultPool'}) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the TrafficClassID is the default pool class",
$pool->{'Name'}
);
return;
}
# Check traffic limits
if (!isNumber($pool->{'TrafficLimitTx'} = $poolData->{'TrafficLimitTx'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the TrafficLimitTx is invalid",
if (!isNumber($pool->{'TxCIR'} = $poolData->{'TxCIR'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the TxCIR is invalid",
$pool->{'Name'}
);
return;
}
if (!isNumber($pool->{'TrafficLimitRx'} = $poolData->{'TrafficLimitRx'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the TrafficLimitRx is invalid",
if (!isNumber($pool->{'RxCIR'} = $poolData->{'RxCIR'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as the RxCIR is invalid",
$pool->{'Name'}
);
return;
}
# If we don't have burst limits, improvize
if (!defined($pool->{'TrafficLimitTxBurst'} = $poolData->{'TrafficLimitTxBurst'})) {
$pool->{'TrafficLimitTxBurst'} = $pool->{'TrafficLimitTx'};
$pool->{'TrafficLimitTx'} = int($pool->{'TrafficLimitTxBurst'}/4);
if (!defined($pool->{'TxLimit'} = $poolData->{'TxLimit'})) {
$pool->{'TxLimit'} = $pool->{'TxCIR'};
$pool->{'TxCIR'} = int($pool->{'TxLimit'}/4);
}
if (!defined($pool->{'TrafficLimitRxBurst'} = $poolData->{'TrafficLimitRxBurst'})) {
$pool->{'TrafficLimitRxBurst'} = $pool->{'TrafficLimitRx'};
$pool->{'TrafficLimitRx'} = int($pool->{'TrafficLimitRxBurst'}/4);
if (!defined($pool->{'RxLimit'} = $poolData->{'RxLimit'})) {
$pool->{'RxLimit'} = $pool->{'RxCIR'};
$pool->{'RxCIR'} = int($pool->{'RxLimit'}/4);
}
# Set source
$pool->{'Source'} = $poolData->{'Source'};
......@@ -1810,31 +2521,34 @@ sub createPool
$pool->{'Notes'} = $poolData->{'Notes'};
# Assign pool ID
$pool->{'ID'} = $poolIDCounter++;
$pool->{'ID'} = $globals->{'PoolIDCounter'}++;
# NK: Need better pool ID determination, check what ID is available
# Add pool
$pools->{$pool->{'ID'}} = $pool;
$globals->{'Pools'}->{$pool->{'ID'}} = $pool;
# Link pool name map
$poolNameMap->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}} = $pool;
$globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}} = $pool;
# Blank our pool member mapping
$poolMemberMap->{$pool->{'ID'}} = { };
$globals->{'PoolMemberMap'}->{$pool->{'ID'}} = { };
setPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE);
# Pool needs updating
$poolChangeQueue->{$pool->{'ID'}} = $pool;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Resolve overrides
_override_resolve([$pool->{'ID'}]);
# Resolve pool overrides
_resolve_pool_override([$pool->{'ID'}]);
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return $pool->{'ID'};
}
# Function to remove a pool
sub removePool
{
......@@ -1846,7 +2560,7 @@ sub removePool
return;
}
my $pool = $pools->{$pid};
my $pool = $globals->{'Pools'}->{$pid};
# Check if pool is not already offlining
if ($pool->{'Status'} == CFGM_OFFLINE) {
......@@ -1862,15 +2576,16 @@ sub removePool
$pool->{'LastUpdate'} = $now;
# Pool needs updating
$poolChangeQueue->{$pool->{'ID'}} = $pool;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return;
}
# Function to change a pool
sub changePool
{
......@@ -1883,7 +2598,7 @@ sub changePool
return;
}
my $pool = $pools->{$poolData->{'ID'}};
my $pool = $globals->{'Pools'}->{$poolData->{'ID'}};
my $now = time();
......@@ -1899,16 +2614,17 @@ sub changePool
$pool->{'LastUpdate'} = $now;
# Pool needs updating
$poolChangeQueue->{$pool->{'ID'}} = $pool;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to return a pool
sub getPool
{
......@@ -1919,16 +2635,17 @@ sub getPool
return;
}
my $pool = dclone($pools->{$pid});
my $pool = dclone($globals->{'Pools'}->{$pid});
# Remove attributes?
delete($pool->{'.attributes'});
delete($pool->{'.applied_attributes'});
delete($pool->{'.applied_overrides'});
return $pool;
}
# Function to get a pool by its name
sub getPoolByName
{
......@@ -1941,21 +2658,26 @@ sub getPoolByName
}
# Maybe it doesn't exist?
if (!defined($poolNameMap->{$interfaceGroupID}) || !defined($poolNameMap->{$interfaceGroupID}->{$name})) {
if (
!defined($globals->{'PoolNameMap'}->{$interfaceGroupID}) ||
!defined($globals->{'PoolNameMap'}->{$interfaceGroupID}->{$name}))
{
return;
}
return dclone($poolNameMap->{$interfaceGroupID}->{$name});
return dclone($globals->{'PoolNameMap'}->{$interfaceGroupID}->{$name});
}
# Function to return a list of pool ID's
sub getPools
{
return (keys %{$pools});
return (keys %{$globals->{'Pools'}});
}
# Function to return a pool TX interface
sub getPoolTxInterface
{
......@@ -1967,10 +2689,11 @@ sub getPoolTxInterface
return;
}
return $config->{'interface_groups'}->{$pools->{$pid}->{'InterfaceGroupID'}}->{'txiface'};
return $globals->{'InterfaceGroups'}->{$globals->{'Pools'}->{$pid}->{'InterfaceGroupID'}}->{'TxInterface'};
}
# Function to return a pool RX interface
sub getPoolRxInterface
{
......@@ -1982,10 +2705,11 @@ sub getPoolRxInterface
return;
}
return $config->{'interface_groups'}->{$pools->{$pid}->{'InterfaceGroupID'}}->{'rxiface'};
return $globals->{'InterfaceGroups'}->{$globals->{'Pools'}->{$pid}->{'InterfaceGroupID'}}->{'RxInterface'};
}
# Function to return a pool traffic class ID
sub getPoolTrafficClassID
{
......@@ -1997,10 +2721,11 @@ sub getPoolTrafficClassID
return;
}
return $pools->{$pid}->{'ClassID'};
return $globals->{'Pools'}->{$pid}->{'TrafficClassID'};
}
# Function to set pools shaper state
sub setPoolShaperState
{
......@@ -2012,12 +2737,13 @@ sub setPoolShaperState
return;
}
$pools->{$pid}->{'.shaper_state'} |= $state;
$globals->{'Pools'}->{$pid}->{'.shaper_state'} |= $state;
return $pools->{$pid}->{'.shaper_state'};
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to unset pools shaper state
sub unsetPoolShaperState
{
......@@ -2029,12 +2755,13 @@ sub unsetPoolShaperState
return;
}
$pools->{$pid}->{'.shaper_state'} ^= $state;
$globals->{'Pools'}->{$pid}->{'.shaper_state'} &= ~$state;
return $pools->{$pid}->{'.shaper_state'};
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to get shaper state for a pool
sub getPoolShaperState
{
......@@ -2046,17 +2773,18 @@ sub getPoolShaperState
return;
}
return $pools->{$pid}->{'.shaper_state'};
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to check the pool ID exists
sub isPoolIDValid
{
my $pid = shift;
if (!defined($pid) || !defined($pools->{$pid})) {
if (!defined($pid) || !defined($globals->{'Pools'}->{$pid})) {
return;
}
......@@ -2064,6 +2792,7 @@ sub isPoolIDValid
}
# Function to return if a pool is ready for any kind of modification
sub isPoolReady
{
......@@ -2076,11 +2805,32 @@ sub isPoolReady
return;
}
return ($pools->{$pid}->{'Status'} == CFGM_ONLINE && $state & SHAPER_LIVE);
return ($globals->{'Pools'}->{$pid}->{'Status'} == CFGM_ONLINE && $state & SHAPER_LIVE);
}
# Function to return a pool with any items changed as per overrides
# Function to check if pool is being overridden or not
sub isPoolOverridden
{
my $pid = shift;
if (!isPoolIDValid($pid)) {
return;
}
# Set a property based on if this pool is overridden or not
if (defined($globals->{'Pools'}->{$pid}->{'.applied_overrides'}) &&
(keys %{$globals->{'Pools'}->{$pid}->{'.applied_overrides'}}) > 0) {
return 1;
}
return 0;
}
# Function to return a pool with any items changed as per pool overrides
sub getEffectivePool
{
my $pid = shift;
......@@ -2091,27 +2841,29 @@ sub getEffectivePool
return;
}
# If we have applied overrides, check out what changes there may be
if (defined(my $appliedOverrides = $pools->{$pid}->{'.applied_overrides'})) {
my $overrideSet;
my $realPool = $globals->{'Pools'}->{$pid};
# Loop with overrides in ascending fashion, least matches to most
foreach my $oid ( sort { $appliedOverrides->{$a} <=> $appliedOverrides->{$b} } keys %{$appliedOverrides}) {
my $override = $overrides->{$oid};
# If we have applied pool overrides, check out what changes there may be
if (defined(my $appliedPoolOverrides = $realPool->{'.applied_overrides'})) {
my $poolOverrideSet;
# Loop with attributes and create our override set
foreach my $attr (OVERRIDE_CHANGESET_ATTRIBUTES) {
# Set override set attribute if the override has defined it
if (defined($override->{$attr}) && $override->{$attr} ne "") {
$overrideSet->{$attr} = $override->{$attr};
# Loop with pool overrides in ascending fashion, least matches to most
foreach my $poid ( sort { $appliedPoolOverrides->{$a} <=> $appliedPoolOverrides->{$b} } keys %{$appliedPoolOverrides}) {
my $poolOverride = $globals->{'PoolOverrides'}->{$poid};
# Loop with attributes and create our pool override set
foreach my $attr (POOL_OVERRIDE_CHANGESET_ATTRIBUTES) {
# Set pool override set attribute if the pool override has defined it
if (defined($poolOverride->{$attr}) && $poolOverride->{$attr} ne "") {
$poolOverrideSet->{$attr} = $poolOverride->{$attr};
}
}
}
# Set overrides on pool
if (defined($overrideSet)) {
foreach my $attr (keys %{$overrideSet}) {
$pool->{$attr} = $overrideSet->{$attr};
# Set pool overrides on pool
if (defined($poolOverrideSet)) {
foreach my $attr (keys %{$poolOverrideSet}) {
$pool->{$attr} = $poolOverrideSet->{$attr};
}
}
}
......@@ -2120,8 +2872,9 @@ sub getEffectivePool
}
# Function to create a pool member
sub createPoolMember
sub createPoolMember
{
my $poolMemberData = shift;
......@@ -2144,37 +2897,46 @@ sub createPoolMember
my $now = time();
# Check if IP address is defined
if (!defined(isIP($poolMember->{'IPAddress'} = $poolMemberData->{'IPAddress'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool member add as the IPAddress is invalid");
if (!defined(isIPv46CIDR($poolMember->{'IPAddress'} = $poolMemberData->{'IPAddress'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add as the IPAddress is invalid");
return;
}
if (defined($poolMemberData->{'IPNATAddress'}) && $poolMemberData->{'IPNATAddress'} ne "") {
if (!defined(isIPv46($poolMember->{'IPNATAddress'} = $poolMemberData->{'IPNATAddress'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add as the IPNATAddress is invalid");
return;
} elsif (defined($poolMemberData->{'IPNATInbound'}) && $poolMemberData->{'IPNATInbound'} eq "yes") {
$poolMember->{'IPNATInbound'} = "yes";
}
}
# Now check if Username its valid
if (!defined(isUsername($poolMember->{'Username'} = $poolMemberData->{'Username'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool member add as Username is invalid");
if (!defined(isUsername($poolMember->{'Username'} = $poolMemberData->{'Username'}, ISUSERNAME_ALLOW_ATSIGN))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add as Username is invalid");
return;
}
# Check pool ID is OK
if (!defined($poolMember->{'PoolID'} = isPoolIDValid($poolMemberData->{'PoolID'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the PoolID is invalid",
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the PoolID is invalid",
$poolMemberData->{'Username'}
);
return;
}
# Grab pool
my $pool = $pools->{$poolMember->{'PoolID'}};
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
# Check match priority ID is OK
if (!defined($poolMember->{'MatchPriorityID'} = isMatchPriorityIDValid($poolMemberData->{'MatchPriorityID'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the MatchPriorityID is invalid",
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the MatchPriorityID is invalid",
$poolMemberData->{'Username'}
);
return;
}
# Check group ID is OK
if (!defined($poolMember->{'GroupID'} = isGroupIDValid($poolMemberData->{'GroupID'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the GroupID is invalid",
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the GroupID is invalid",
$poolMemberData->{'Username'}
);
return;
......@@ -2194,13 +2956,13 @@ sub createPoolMember
$poolMember->{'Notes'} = $poolMemberData->{'Notes'};
# Create pool member ID
$poolMember->{'ID'} = $poolMemberIDCounter++;
$poolMember->{'ID'} = $globals->{'PoolMemberIDCounter'}++;
# Add pool member
$poolMembers->{$poolMember->{'ID'}} = $poolMember;
$globals->{'PoolMembers'}->{$poolMember->{'ID'}} = $poolMember;
# Link pool map
$poolMemberMap->{$pool->{'ID'}}->{$poolMember->{'ID'}} = $poolMember;
$globals->{'PoolMemberMap'}->{$pool->{'ID'}}->{$poolMember->{'ID'}} = $poolMember;
# Updated pool's last updated timestamp
$pool->{'LastUpdate'} = $now;
......@@ -2213,14 +2975,15 @@ sub createPoolMember
# Check for IP conflicts
if (
defined($interfaceIPMap->{$pool->{'InterfaceGroupID'}}->{$poolMember->{'IPAddress'}}) &&
(my @conflicts = keys %{$interfaceIPMap->{$pool->{'InterfaceGroupID'}}->{$poolMember->{'IPAddress'}}}) > 0
defined($globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}->{$poolMember->{'IPAddress'}}) &&
(my @conflicts = keys %{$globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}
->{$poolMember->{'IPAddress'}}}) > 0
) {
# Loop wiht conflicts and build some log items to use
my @logItems;
foreach my $pmid (@conflicts) {
my $cPoolMember = $poolMembers->{$pmid};
my $cPool = $pools->{$cPoolMember->{'PoolID'}};
my $cPoolMember = $globals->{'PoolMembers'}->{$pmid};
my $cPool = $globals->{'Pools'}->{$cPoolMember->{'PoolID'}};
push(@logItems,sprintf("Pool:%s/Member:%s",$cPool->{'Name'},$cPoolMember->{'Username'}));
}
......@@ -2231,27 +2994,29 @@ sub createPoolMember
join(", ",@logItems)
);
# We don't have to add it to the queue, as its in a conflicted state
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_CONFLICT);
# We don't have to add it to the queue
} else {
# Pool member needs updating
$poolMemberChangeQueue->{$poolMember->{'ID'}} = $poolMember;
$globals->{'PoolMemberChangeQueue'}->{$poolMember->{'ID'}} = $poolMember;
}
# Link interface IP address map, we must do the check above FIRST, and that neds the pool to be added to the pool map
$interfaceIPMap->{$pool->{'InterfaceGroupID'}}->{$poolMember->{'IPAddress'}}->{$poolMember->{'ID'}} = $poolMember;
# Link interface IP address map, we must do the check above FIRST, as that needs the pool to be added to the pool map
$globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}->{$poolMember->{'IPAddress'}}
->{$poolMember->{'ID'}} = $poolMember;
# Resolve overrides, there may of been no pool members, now there is one and we may be able to apply an override
_override_resolve([$pool->{'ID'}]);
# Resolve pool overrides, there may of been no pool members, now there is one and we may be able to apply a pool override
_resolve_pool_override([$pool->{'ID'}]);
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return $poolMember->{'ID'};
}
# Function to remove pool member, this function is actually just going to flag it offline
# the offline pool members will be caught by cleanup and removed, we do this because we
# need the pool member setup in the removal functions, we cannot remove it first, and we
......@@ -2266,7 +3031,7 @@ sub removePoolMember
return;
}
my $poolMember = $poolMembers->{$pmid};
my $poolMember = $globals->{'PoolMembers'}->{$pmid};
# Check if pool member is not already offlining
if ($poolMember->{'Status'} == CFGM_OFFLINE) {
......@@ -2276,7 +3041,7 @@ sub removePoolMember
my $now = time();
# Grab pool
my $pool = $pools->{$poolMember->{'PoolID'}};
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
# Updated pool's last updated timestamp
$pool->{'LastUpdate'} = $now;
......@@ -2288,15 +3053,16 @@ sub removePoolMember
$poolMember->{'LastUpdate'} = $now;
# Pool member needs updating
$poolMemberChangeQueue->{$poolMember->{'ID'}} = $poolMember;
$globals->{'PoolMemberChangeQueue'}->{$poolMember->{'ID'}} = $poolMember;
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return;
}
# Function to change a pool member
sub changePoolMember
{
......@@ -2309,8 +3075,8 @@ sub changePoolMember
return;
}
my $poolMember = $poolMembers->{$poolMemberData->{'ID'}};
my $pool = $pools->{$poolMember->{'PoolID'}};
my $poolMember = $globals->{'PoolMembers'}->{$poolMemberData->{'ID'}};
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
my $now = time();
......@@ -2327,13 +3093,14 @@ sub changePoolMember
$pool->{'LastUpdate'} = $now;
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to return a list of pool ID's
sub getPoolMembers
{
......@@ -2346,14 +3113,15 @@ sub getPoolMembers
}
# Check our member map is not undefined
if (!defined($poolMemberMap->{$pid})) {
if (!defined($globals->{'PoolMemberMap'}->{$pid})) {
return;
}
return keys %{$poolMemberMap->{$pid}};
return keys %{$globals->{'PoolMemberMap'}->{$pid}};
}
# Function to return a pool member
sub getPoolMember
{
......@@ -2365,7 +3133,7 @@ sub getPoolMember
return;
}
my $poolMember = dclone($poolMembers->{$pmid});
my $poolMember = dclone($globals->{'PoolMembers'}->{$pmid});
# Remove attributes?
delete($poolMember->{'.attributes'});
......@@ -2374,6 +3142,7 @@ sub getPoolMember
}
# Function to return a list of pool ID's
sub getPoolMemberByUsernameIP
{
......@@ -2386,13 +3155,13 @@ sub getPoolMemberByUsernameIP
}
# Check our member map is not undefined
if (!defined($poolMemberMap->{$pid})) {
if (!defined($globals->{'PoolMemberMap'}->{$pid})) {
return;
}
# Loop with pool members and grab the match, there can only be one as we cannot conflict username and IP
foreach my $pmid (keys %{$poolMemberMap->{$pid}}) {
my $poolMember = $poolMemberMap->{$pid}->{$pmid};
foreach my $pmid (keys %{$globals->{'PoolMemberMap'}->{$pid}}) {
my $poolMember = $globals->{'PoolMemberMap'}->{$pid}->{$pmid};
if ($poolMember->{'Username'} eq $username && $poolMember->{'IPAddress'} eq $ipAddress) {
return $pmid;
......@@ -2403,6 +3172,7 @@ sub getPoolMemberByUsernameIP
}
# Function to return pool member ID's with a certain IP address using an interface group
sub getAllPoolMembersByInterfaceGroupIP
{
......@@ -2415,21 +3185,22 @@ sub getAllPoolMembersByInterfaceGroupIP
}
# Maybe it doesn't exist?
if (!defined($interfaceIPMap->{$interfaceGroupID}) || !defined($interfaceIPMap->{$interfaceGroupID}->{$ipAddress})) {
if (!defined($globals->{'InterfaceGroups'}->{$interfaceGroupID}->{'IPMap'}->{$ipAddress})) {
return;
}
return keys %{$interfaceIPMap->{$interfaceGroupID}->{$ipAddress}};
return keys %{$globals->{'InterfaceGroups'}->{$interfaceGroupID}->{'IPMap'}->{$ipAddress}};
}
# Function to check the pool member ID exists
sub isPoolMemberIDValid
{
my $pmid = shift;
if (!defined($pmid) || !defined($poolMembers->{$pmid})) {
if (!defined($pmid) || !defined($globals->{'PoolMembers'}->{$pmid})) {
return;
}
......@@ -2437,6 +3208,7 @@ sub isPoolMemberIDValid
}
# Function to return if a pool member is ready for any kind of modification
sub isPoolMemberReady
{
......@@ -2448,10 +3220,11 @@ sub isPoolMemberReady
return;
}
return ($poolMembers->{$pmid}->{'Status'} == CFGM_ONLINE && getPoolMemberShaperState($pmid) & SHAPER_LIVE);
return ($globals->{'PoolMembers'}->{$pmid}->{'Status'} == CFGM_ONLINE && getPoolMemberShaperState($pmid) & SHAPER_LIVE);
}
# Function to return a pool member match priority
sub getPoolMemberMatchPriority
{
......@@ -2464,10 +3237,11 @@ sub getPoolMemberMatchPriority
}
# NK: No actual mappping yet, we just return the ID
return $poolMembers->{$pmid}->{'MatchPriorityID'};
return $globals->{'PoolMembers'}->{$pmid}->{'MatchPriorityID'};
}
# Function to set a pool member attribute
sub setPoolMemberAttribute
{
......@@ -2479,12 +3253,13 @@ sub setPoolMemberAttribute
return;
}
$poolMembers->{$pmid}->{'.attributes'}->{$attr} = $value;
$globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr} = $value;
return $value;
}
# Function to set pool member shaper state
sub setPoolMemberShaperState
{
......@@ -2496,12 +3271,13 @@ sub setPoolMemberShaperState
return;
}
$poolMembers->{$pmid}->{'.shaper_state'} |= $state;
$globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'} |= $state;
return $poolMembers->{$pmid}->{'.shaper_state'};
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Function to unset pool member shaper state
sub unsetPoolMemberShaperState
{
......@@ -2513,12 +3289,13 @@ sub unsetPoolMemberShaperState
return;
}
$poolMembers->{$pmid}->{'.shaper_state'} ^= $state;
$globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'} &= ~$state;
return $poolMembers->{$pmid}->{'.shaper_state'};
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Function to get shaper state for a pool
sub getPoolMemberShaperState
{
......@@ -2530,10 +3307,11 @@ sub getPoolMemberShaperState
return;
}
return $poolMembers->{$pmid}->{'.shaper_state'};
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Function to get a pool member attribute
sub getPoolMemberAttribute
{
......@@ -2546,14 +3324,18 @@ sub getPoolMemberAttribute
}
# Check if attribute exists first
if (!defined($poolMembers->{$pmid}->{'.attributes'}) || !defined($poolMembers->{$pmid}->{'.attributes'}->{$attr})) {
if (
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}) ||
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr}))
{
return;
}
return $poolMembers->{$pmid}->{'.attributes'}->{$attr};
return $globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr};
}
# Function to remove a pool member attribute
sub removePoolMemberAttribute
{
......@@ -2566,14 +3348,18 @@ sub removePoolMemberAttribute
}
# Check if attribute exists first
if (!defined($poolMembers->{$pmid}->{'.attributes'}) || !defined($poolMembers->{$pmid}->{'.attributes'}->{$attr})) {
if (
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}) ||
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr}))
{
return;
}
return delete($poolMembers->{$pmid}->{'.attributes'}->{$attr});
return delete($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr});
}
# Create a limit, which is the combination of a pool and a pool member
sub createLimit
{
......@@ -2594,21 +3380,30 @@ sub createLimit
}
# Check if IP address is defined
if (!defined(isIP($limitData->{'IPAddress'} = $limitData->{'IPAddress'}))) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Cannot process limit add as the IP address is invalid");
if (!defined(isIPv46CIDR($limitData->{'IPAddress'} = $limitData->{'IPAddress'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as the IPAddress is invalid");
return;
}
if (defined($limitData->{'IPNATAddress'}) && $limitData->{'IPNATAddress'} ne "") {
if (!defined(isIPv46($limitData->{'IPNATAddress'} = $limitData->{'IPNATAddress'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as the IPNATAddress is invalid");
return;
}
}
if (defined($limitData->{'IPNATInbound'}) && $limitData->{'IPNATInbound'} eq "yes") {
$limitData->{'IPNATInbound'} = "yes";
}
my $poolName = $limitData->{'Username'};
my $poolData = {
'FriendlyName' => $limitData->{'IPAddress'},
'FriendlyName' => $limitData->{'FriendlyName'} || $limitData->{'IPAddress'},
'Name' => $poolName,
'InterfaceGroupID' => $limitData->{'InterfaceGroupID'},
'ClassID' => $limitData->{'ClassID'},
'TrafficLimitTx' => $limitData->{'TrafficLimitTx'},
'TrafficLimitTxBurst' => $limitData->{'TrafficLimitTxBurst'},
'TrafficLimitRx' => $limitData->{'TrafficLimitRx'},
'TrafficLimitRxBurst' => $limitData->{'TrafficLimitRxBurst'},
'TrafficClassID' => $limitData->{'TrafficClassID'},
'TxCIR' => $limitData->{'TxCIR'},
'TxLimit' => $limitData->{'TxLimit'},
'RxCIR' => $limitData->{'RxCIR'},
'RxLimit' => $limitData->{'RxLimit'},
'Expires' => $limitData->{'Expires'},
'Notes' => $limitData->{'Notes'},
'Source' => $limitData->{'Source'}
......@@ -2642,273 +3437,213 @@ sub createLimit
}
# Function to create a override
sub createOverride
# Function to create a pool override
sub createPoolOverride
{
my $overrideData = shift;
my $poolOverrideData = shift;
# Check that we have at least one match attribute
my $isValid = 0;
foreach my $item (OVERRIDE_MATCH_ATTRIBUTES) {
$isValid++;
foreach my $item (POOL_OVERRIDE_MATCH_ATTRIBUTES) {
# Bump up $isValid if we have a match attribute
if (defined($poolOverrideData->{$item})) {
$isValid++;
}
}
if (!$isValid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process override as there is no selection attribute");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool override as there is no selection attribute");
return;
}
my $override;
my $poolOverride;
my $now = time();
# Pull in attributes
foreach my $item (OVERRIDE_ATTRIBUTES) {
$override->{$item} = $overrideData->{$item};
foreach my $item (POOL_OVERRIDE_ATTRIBUTES) {
$poolOverride->{$item} = $poolOverrideData->{$item};
}
# Check group is OK
if (defined($override->{'GroupID'}) && !isGroupIDValid($override->{'GroupID'})) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process override for user '%s', IP '%s', GroupID '%s' as the GroupID is ".
"invalid",
prettyUndef($override->{'Username'}),
prettyUndef($override->{'IPAddress'}),
prettyUndef($override->{'GroupID'})
if (defined($poolOverride->{'GroupID'}) && !isGroupIDValid($poolOverride->{'GroupID'})) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process pool override for user '%s', IP '%s', GroupID '%s' as the ".
"GroupID is invalid",
prettyUndef($poolOverride->{'Username'}),
prettyUndef($poolOverride->{'IPAddress'}),
prettyUndef($poolOverride->{'GroupID'})
);
return;
}
# Check class is OK
if (defined($override->{'ClassID'}) && !isTrafficClassIDValid($override->{'ClassID'})) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process override for user '%s', IP '%s', GroupID '%s' as the ClassID is ".
"invalid",
prettyUndef($override->{'Username'}),
prettyUndef($override->{'IPAddress'}),
prettyUndef($override->{'GroupID'})
if (defined($poolOverride->{'TrafficClassID'}) && !isTrafficClassIDValid($poolOverride->{'TrafficClassID'})) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process pool override for user '%s', IP '%s', GroupID '%s' as the ".
"TrafficClassID is invalid",
prettyUndef($poolOverride->{'Username'}),
prettyUndef($poolOverride->{'IPAddress'}),
prettyUndef($poolOverride->{'GroupID'})
);
return;
}
# Set source
$override->{'Source'} = $overrideData->{'Source'};
$poolOverride->{'Source'} = $poolOverrideData->{'Source'};
# Set when this entry was created
$override->{'Created'} = defined($overrideData->{'Created'}) ? $overrideData->{'Created'} : $now;
$override->{'LastUpdate'} = $now;
$poolOverride->{'Created'} = defined($poolOverrideData->{'Created'}) ? $poolOverrideData->{'Created'} : $now;
$poolOverride->{'LastUpdate'} = $now;
# Set when this entry expires
$override->{'Expires'} = defined($overrideData->{'Expires'}) ? int($overrideData->{'Expires'}) : 0;
$poolOverride->{'Expires'} = defined($poolOverrideData->{'Expires'}) ? int($poolOverrideData->{'Expires'}) : 0;
# Check status is OK
$override->{'Status'} = CFGM_NEW;
$poolOverride->{'Status'} = CFGM_NEW;
# Set friendly name and notes
$override->{'FriendlyName'} = $overrideData->{'FriendlyName'};
$poolOverride->{'FriendlyName'} = $poolOverrideData->{'FriendlyName'};
# Set notes
$override->{'Notes'} = $overrideData->{'Notes'};
$poolOverride->{'Notes'} = $poolOverrideData->{'Notes'};
# Create pool member ID
$override->{'ID'} = $overrideIDCounter++;
$poolOverride->{'ID'} = $globals->{'PoolOverrideIDCounter'}++;
# Add override
$overrides->{$override->{'ID'}} = $override;
# Add pool override
$globals->{'PoolOverrides'}->{$poolOverride->{'ID'}} = $poolOverride;
# Resolve overrides
_override_resolve(undef,[$override->{'ID'}]);
# Resolve pool overrides
_resolve_pool_override(undef,[$poolOverride->{'ID'}]);
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return $override->{'ID'};
return $poolOverride->{'ID'};
}
# Function to remove an override
sub removeOverride
# Function to remove a pool override
sub removePoolOverride
{
my $oid = shift;
my $poid = shift;
# Check override exists first
if (!isOverrideIDValid($oid)) {
# Check pool override exists first
if (!isPoolOverrideIDValid($poid)) {
return;
}
my $override = $overrides->{$oid};
my $poolOverride = $globals->{'PoolOverrides'}->{$poid};
# Remove override from pools that have it and trigger a change
if (defined($override->{'.applied_pools'})) {
foreach my $pid (keys %{$override->{'.applied_pools'}}) {
my $pool = $pools->{$pid};
# Remove pool override from pools that have it and trigger a change
if (defined($poolOverride->{'.applied_pools'})) {
foreach my $pid (keys %{$poolOverride->{'.applied_pools'}}) {
my $pool = $globals->{'Pools'}->{$pid};
# Remove overrides from the pool
delete($pool->{'.applied_overrides'}->{$override->{'ID'}});
# Remove pool overrides from the pool
delete($pool->{'.applied_overrides'}->{$poolOverride->{'ID'}});
# If the pool is online and live, trigger a change
if ($pool->{'Status'} == CFGM_ONLINE && getPoolShaperState($pid) & SHAPER_LIVE) {
$poolChangeQueue->{$pool->{'ID'}} = $pool;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
$pool->{'Status'} = CFGM_CHANGED;
}
}
}
# Remove override
delete($overrides->{$override->{'ID'}});
# Remove pool override
delete($globals->{'PoolOverrides'}->{$poolOverride->{'ID'}});
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
return;
}
# Function to change an override
sub changeOverride
# Function to change a pool override
sub changePoolOverride
{
my $overrideData = shift;
my $poolOverrideData = shift;
# Check override exists first
if (!isOverrideIDValid($overrideData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process override change as there is no 'ID' attribute");
# Check pool override exists first
if (!isPoolOverrideIDValid($poolOverrideData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool override change as there is no 'ID' attribute");
return;
}
my $override = $overrides->{$overrideData->{'ID'}};
my $poolOverride = $globals->{'PoolOverrides'}->{$poolOverrideData->{'ID'}};
my $now = time();
my $changes = getHashChanges($override,$overrideData,[OVERRIDE_CHANGE_ATTRIBUTES]);
my $changes = getHashChanges($poolOverride,$poolOverrideData,[POOL_OVERRIDE_CHANGE_ATTRIBUTES]);
# Make changes...
foreach my $item (keys %{$changes}) {
$override->{$item} = $changes->{$item};
$poolOverride->{$item} = $changes->{$item};
}
# Set status to updated
$override->{'Status'} = CFGM_CHANGED;
$poolOverride->{'Status'} = CFGM_CHANGED;
# Set timestamp
$override->{'LastUpdate'} = $now;
$poolOverride->{'LastUpdate'} = $now;
# Resolve overrides to see if any attributes changed, we only do this if it already matches
# Resolve pool overrides to see if any attributes changed, we only do this if it already matches
# We do NOT support changing match attributes
if (defined($override->{'.applied_pools'}) && (my @pids = keys %{$override->{'.applied_pools'}}) > 0) {
_override_resolve([@pids],[$override->{'ID'}]);
if (defined($poolOverride->{'.applied_pools'}) && (my @pids = keys %{$poolOverride->{'.applied_pools'}}) > 0) {
_resolve_pool_override([@pids],[$poolOverride->{'ID'}]);
}
# Bump up changes
$stateChanged++;
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to check the override ID exists
sub isOverrideIDValid
{
my $oid = shift;
if (!defined($oid) || !defined($overrides->{$oid})) {
return;
}
return $oid;
}
# Function to get traffic classes
sub getTrafficClasses
{
my $classes = dclone($config->{'classes'});
# Remove default pool class if we have one
if (defined(my $classID = $config->{'default_pool'})) {
delete($classes->{$classID});
}
return $classes;
}
# Function to get all traffic classes
sub getAllTrafficClasses
{
my $classes = dclone($config->{'classes'});
return $classes;
}
# Function to get class name
sub getTrafficClassName
{
my $classID = shift;
if (!isTrafficClassIDValid($classID)) {
return;
}
return $config->{'classes'}->{$classID};
}
# Function to check if traffic class is valid
sub isTrafficClassIDValid
# Function to check the pool override ID exists
sub isPoolOverrideIDValid
{
my $classID = shift;
my $poid = shift;
if (!defined($classID) || !defined($config->{'classes'}->{$classID})) {
if (!defined($poid) || !defined($globals->{'PoolOverrides'}->{$poid})) {
return;
}
return $classID;
return $poid;
}
# Function to return the traffic priority based on a traffic class
sub getTrafficClassPriority
{
my $classID = shift;
# Check it exists first
if (!isTrafficClassIDValid($classID)) {
return;
}
# NK: Short circuit, our ClassID = Priority
return $classID;
}
#
# Internal functions
#
# Resolve all overrides or those linked to a pid or oid
# We take 2 optional argument, which is a single override and a single pool to process
sub _override_resolve
# Resolve all pool overrides or those linked to a pid or oid
# We take 2 optional argument, which is a single pool override and a single pool to process
sub _resolve_pool_override
{
my ($pids,$oids) = @_;
my ($pids,$poids) = @_;
# Hack to intercept and create a single element hash if we get ID's above
my $poolHash;
if (defined($pids)) {
foreach my $pid (@{$pids}) {
$poolHash->{$pid} = $pools->{$pid};
$poolHash->{$pid} = $globals->{'Pools'}->{$pid};
}
} else {
$poolHash = $pools;
$poolHash = $globals->{'Pools'};
}
my $overrideHash;
if (defined($oids)) {
foreach my $oid (@{$oids}) {
$overrideHash->{$oid} = $overrides->{$oid};
my $poolOverrideHash;
if (defined($poids)) {
foreach my $poid (@{$poids}) {
$poolOverrideHash->{$poid} = $globals->{'PoolOverrides'}->{$poid};
}
} else {
$overrideHash = $overrides;
$poolOverrideHash = $globals->{'PoolOverrides'};
}
# Loop with all pools, keep a list of pid's updated
......@@ -2926,69 +3661,71 @@ sub _override_resolve
$candidate->{'IPAddress'} = $poolMember->{'IPAddress'};
$candidate->{'GroupID'} = $poolMember->{'GroupID'};
}
# Loop with all overrides and generate a match list
while ((my $oid, my $override) = each(%{$overrideHash})) {
# Loop with all pool overrides and generate a match list
while ((my $poid, my $poolOverride) = each(%{$poolOverrideHash})) {
my $numMatches = 0;
my $numMismatches = 0;
# Loop with the attributes and check for a full match
foreach my $attr (OVERRIDE_MATCH_ATTRIBUTES) {
# If this attribute in the override is set, then lets check it
if (defined($override->{$attr}) && $override->{$attr} ne "") {
# Check for match or mismatch
if (defined($candidate->{$attr}) && $candidate->{$attr} eq $override->{$attr}) {
$numMatches++;
} else {
$numMismatches++;
foreach my $attr (POOL_OVERRIDE_MATCH_ATTRIBUTES) {
# If this attribute in the pool override is set, then lets check it
if (defined($poolOverride->{$attr}) && $poolOverride->{$attr} ne "") {
# Check for match or mismatch, only if candidate attribute is defined
if (defined($candidate->{$attr})) {
if ($candidate->{$attr} eq $poolOverride->{$attr}) {
$numMatches++;
} else {
$numMismatches++;
}
}
}
}
# Setup the match list with what was matched
if ($numMatches && !$numMismatches) {
$matchList->{$pid}->{$oid} = $numMatches;
$matchList->{$pid}->{$poid} = $numMatches;
} else {
$matchList->{$pid}->{$oid} = undef;
$matchList->{$pid}->{$poid} = undef;
}
}
}
# Loop with the match list
foreach my $pid (keys %{$matchList}) {
my $pool = $pools->{$pid};
my $pool = $globals->{'Pools'}->{$pid};
# Original Effective pool
my $oePool = getEffectivePool($pid);
# Loop with overrides for this pool
foreach my $oid (keys %{$matchList->{$pid}}) {
my $override = $overrides->{$oid};
# Loop with pool overrides for this pool
foreach my $poid (keys %{$matchList->{$pid}}) {
my $poolOverride = $globals->{'PoolOverrides'}->{$poid};
# If we have a match, record it in pools & overrides
if (defined($matchList->{$pid}->{$oid})) {
# If we have a match, record it in pools & pool overrides
if (defined($matchList->{$pid}->{$poid})) {
# Setup trakcing of what is applied to what
$overrides->{$oid}->{'.applied_pools'}->{$pid} = $matchList->{$pid}->{$oid};
$pools->{$pid}->{'.applied_overrides'}->{$oid} = $matchList->{$pid}->{$oid};
$globals->{'PoolOverrides'}->{$poid}->{'.applied_pools'}->{$pid} = $matchList->{$pid}->{$poid};
$globals->{'Pools'}->{$pid}->{'.applied_overrides'}->{$poid} = $matchList->{$pid}->{$poid};
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Override '%s' [%s] applied to pool '%s' [%s]",
$override->{'FriendlyName'},
$override->{'ID'},
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Pool override '%s' [%s] applied to pool '%s' [%s]",
$poolOverride->{'FriendlyName'},
$poolOverride->{'ID'},
$pool->{'Name'},
$pool->{'ID'}
);
# We didn't match, but we may of matched before?
} else {
# There was an override before, so something changed now that there is none
if (defined($pools->{$pid}->{'.applied_overrides'}->{$oid})) {
# Remove overrides
delete($pools->{$pid}->{'.applied_overrides'}->{$oid});
delete($overrides->{$oid}->{'.applied_pools'}->{$pid});
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Override '%s' no longer applies to pool '%s' [%s]",
$override->{'ID'},
# There was a pool override before, so something changed now that there is none
if (defined($globals->{'Pools'}->{$pid}->{'.applied_overrides'}->{$poid})) {
# Remove pool overrides
delete($globals->{'Pools'}->{$pid}->{'.applied_overrides'}->{$poid});
delete($globals->{'PoolOverrides'}->{$poid}->{'.applied_pools'}->{$pid});
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Pool override '%s' no longer applies to pool '%s' [%s]",
$poolOverride->{'ID'},
$pool->{'Name'},
$pool->{'ID'}
);
......@@ -2999,22 +3736,23 @@ sub _override_resolve
my $nePool = getEffectivePool($pid);
# Get changes between effective pool states
my $poolChanges = getHashChanges($oePool,$nePool,[OVERRIDE_CHANGESET_ATTRIBUTES]);
my $poolChanges = getHashChanges($oePool,$nePool,[POOL_OVERRIDE_CHANGESET_ATTRIBUTES]);
# If there were pool changes, trigger a pool update
if (keys %{$poolChanges} > 0) {
# If the pool is currently online and live, trigger a change
if ($pool->{'Status'} == CFGM_ONLINE && getPoolShaperState($pid) & SHAPER_LIVE) {
$pool->{'Status'} = CFGM_CHANGED;
$poolChangeQueue->{$pool->{'ID'}} = $pool;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
}
}
}
}
# Remove pool override information
sub _override_remove_pool
sub _remove_pool_override
{
my $pid = shift;
......@@ -3023,17 +3761,18 @@ sub _override_remove_pool
return;
}
my $pool = $pools->{$pid};
my $pool = $globals->{'Pools'}->{$pid};
# Remove pool from overrides if there are any
# Remove pool from pool overrides if there are any
if (defined($pool->{'.applied_overrides'})) {
foreach my $oid (keys %{$pool->{'.applied_overrides'}}) {
delete($overrides->{$oid}->{'.applied_pools'}->{$pool->{'ID'}});
foreach my $poid (keys %{$pool->{'.applied_overrides'}}) {
delete($globals->{'PoolOverrides'}->{$poid}->{'.applied_pools'}->{$pool->{'ID'}});
}
}
}
# Load our statefile
sub _load_statefile
{
......@@ -3069,24 +3808,44 @@ sub _load_statefile
# Grab the object handle
my $state = tied( %stateHash );
# Loop with user overrides
foreach my $section ($state->GroupMembers('override')) {
my $override = $stateHash{$section};
# Loop with interface traffic class overrides
foreach my $section ($state->GroupMembers('interface_traffic_class.override')) {
my $classOverride = $stateHash{$section};
# Loop with the persistent attributes and create our hash
my $cClassOverride;
foreach my $attr (CLASS_OVERRIDE_PERSISTENT_ATTRIBUTES) {
if (defined($classOverride->{$attr})) {
# If its an array, join all the items
if (ref($classOverride->{$attr}) eq "ARRAY") {
$classOverride->{$attr} = join("\n",@{$classOverride->{$attr}});
}
$cClassOverride->{$attr} = $classOverride->{$attr};
}
}
# XXX - Hack, Proces this class override
changeInterfaceTrafficClass($cClassOverride);
}
# Loop with user pool overrides
foreach my $section ($state->GroupMembers('pool.override')) {
my $poolOverride = $stateHash{$section};
# Loop with the persistent attributes and create our hash
my $coverride;
foreach my $attr (OVERRIDE_PERSISTENT_ATTRIBUTES) {
if (defined($override->{$attr})) {
my $cPoolOverride;
foreach my $attr (POOL_OVERRIDE_PERSISTENT_ATTRIBUTES) {
if (defined($poolOverride->{$attr})) {
# If its an array, join all the items
if (ref($override->{$attr}) eq "ARRAY") {
$override->{$attr} = join("\n",@{$override->{$attr}});
if (ref($poolOverride->{$attr}) eq "ARRAY") {
$poolOverride->{$attr} = join("\n",@{$poolOverride->{$attr}});
}
$coverride->{$attr} = $override->{$attr};
$cPoolOverride->{$attr} = $poolOverride->{$attr};
}
}
# Proces this override
createOverride($coverride);
# Proces this pool override
createPoolOverride($cPoolOverride);
}
# We need a pool ID translation, when we recreate pools we get different ID's, we cannot restore members with orignal ID's
......@@ -3153,6 +3912,7 @@ sub _load_statefile
}
# Write out statefile
sub _write_statefile
{
......@@ -3160,8 +3920,8 @@ sub _write_statefile
# We reset this early so we don't get triggred continuously if we encounter errors
$stateChanged = 0;
$lastStateSync = time();
$globals->{'StateChanged'} = 0;
$globals->{'LastStateSync'} = time();
# Check if the state file exists first of all
if (!defined($config->{'statefile'})) {
......@@ -3169,9 +3929,9 @@ sub _write_statefile
return;
}
# Only write out if we actually have limits & overrides, else we may of crashed?
if (!(keys %{$pools}) && !(keys %{$overrides})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Not writing state file as there are no active pools or overrides");
# Only write out if we actually have limits & pool overrides, else we may of crashed?
if (!(keys %{$globals->{'Pools'}}) && !(keys %{$globals->{'PoolOverrides'}})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Not writing state file as there are no active pools or pool overrides");
return;
}
......@@ -3182,25 +3942,52 @@ sub _write_statefile
# Create new state file object
my $state = new Config::IniFiles();
# Loop with overrides
while ((my $oid, my $override) = each(%{$overrides})) {
# XXX - Hack, loop with class overrides
while ((my $itcid, my $interfaceTrafficClass) = each(%{$globals->{'InterfaceTrafficClasses'}})) {
# Skip over non-overridden classes
if (!defined($interfaceTrafficClass->{'.applied_overrides'})) {
next;
}
# Create a section name
my $section = "override " . $oid;
my $section = "interface_traffic_class.override " . $itcid;
# Add a section for this override
# Add a section for this class override
$state->AddSection($section);
# Attributes we want to save for this override
foreach my $attr (OVERRIDE_PERSISTENT_ATTRIBUTES) {
# XXX - Hack, Attributes we want to save for this traffic class override
foreach my $attr (CLASS_OVERRIDE_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $interfaceTrafficClass->{$attr})) {
$state->newval($section,$attr,$value);
}
}
# XXX - Hack, loop with the override
foreach my $attr (CLASS_OVERRIDE_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $overrides->{$oid}->{$attr})) {
if (defined(my $value = $interfaceTrafficClass->{'.applied_overrides'}->{'change'}->{$attr})) {
$state->newval($section,$attr,$value);
}
}
}
# Loop with pool overrides
while ((my $poid, my $poolOverride) = each(%{$globals->{'PoolOverrides'}})) {
# Create a section name
my $section = "pool.override " . $poid;
# Add a section for this pool override
$state->AddSection($section);
# Attributes we want to save for this pool override
foreach my $attr (POOL_OVERRIDE_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $globals->{'PoolOverrides'}->{$poid}->{$attr})) {
$state->newval($section,$attr,$value);
}
}
}
# Loop with pools
while ((my $pid, my $pool) = each(%{$pools})) {
while ((my $pid, my $pool) = each(%{$globals->{'Pools'}})) {
# Skip over dynamic entries, we only want persistent ones unless we doing a full write
next if (!$fullWrite && $pool->{'Source'} eq "plugin.radius");
......@@ -3218,14 +4005,14 @@ sub _write_statefile
}
# Save pool members too
foreach my $pmid (keys %{$poolMemberMap->{$pid}}) {
foreach my $pmid (keys %{$globals->{'PoolMemberMap'}->{$pid}}) {
# Create a section name for the pool member
$section = "pool_member " . $pmid;
# Add a new section for this pool member
$state->AddSection($section);
my $poolMember = $poolMembers->{$pmid};
my $poolMember = $globals->{'PoolMembers'}->{$pmid};
# Items we want for persistent entries
foreach my $attr (POOLMEMBER_PERSISTENT_ATTRIBUTES) {
......@@ -3266,5 +4053,6 @@ sub _write_statefile
}
1;
# vim: ts=4
opentrafficshaper/plugins/radius/radius.pm
View file @ efc9ebe1
# OpenTrafficShaper radius module
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -29,7 +29,7 @@ use POE;
use IO::Socket::INET;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use awitpt::util;
use opentrafficshaper::plugins::configmanager qw(
createPool
changePool
......@@ -61,7 +61,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.2.1',
VERSION => '1.0.0',
DATAGRAM_MAXLEN => 8192,
......@@ -86,9 +86,12 @@ our $pluginInfo = {
};
# Copy of system globals
# Our globals
my $globals;
# Copy of system logger
my $logger;
# Our own data storage
my $config = {
'expiry_period' => DEFAULT_EXPIRY_PERIOD,
......@@ -99,32 +102,34 @@ my $config = {
'group' => 1,
};
my $dictionary;
# Initialize plugin
sub plugin_init
{
$globals = shift;
my $system = shift;
# Setup our environment
$logger = $globals->{'logger'};
$logger = $system->{'logger'};
$logger->log(LOG_NOTICE,"[RADIUS] OpenTrafficShaper Radius Module v%s - Copyright (c) 2013-2014, AllWorldIT",VERSION);
# Inititalize
$globals->{'Dictionary'} = undef;
# Split off dictionaries to load
my @dicts = ref($globals->{'file.config'}->{'plugin.radius'}->{'dictionary'}) eq "ARRAY" ?
@{$globals->{'file.config'}->{'plugin.radius'}->{'dictionary'}} :
( $globals->{'file.config'}->{'plugin.radius'}->{'dictionary'} );
my @dicts = ref($system->{'file.config'}->{'plugin.radius'}->{'dictionary'}) eq "ARRAY" ?
@{$system->{'file.config'}->{'plugin.radius'}->{'dictionary'}} :
( $system->{'file.config'}->{'plugin.radius'}->{'dictionary'} );
foreach my $dict (@dicts) {
$dict =~ s/\s+//g;
# Skip comments
next if ($dict =~ /^#/);
# Skip comments
next if ($dict =~ /^#/);
# Check if we have a path, if we do use it
if (defined($globals->{'file.config'}->{'plugin.radius'}->{'dictionary_path'})) {
$dict = $globals->{'file.config'}->{'plugin.radius'}->{'dictionary_path'} . "/$dict";
if (defined($system->{'file.config'}->{'plugin.radius'}->{'dictionary_path'})) {
$dict = $system->{'file.config'}->{'plugin.radius'}->{'dictionary_path'} . "/$dict";
}
push(@{$config->{'config.dictionaries'}},$dict);
}
......@@ -142,22 +147,22 @@ sub plugin_init
}
$logger->log(LOG_DEBUG,"[RADIUS] Loading dictionaries completed.");
# Store the dictionary
$dictionary = $dict;
$globals->{'Dictionary'} = $dict;
# Check if we must override the expiry time
if (defined(my $expiry = $globals->{'file.config'}->{'plugin.radius'}->{'expiry_period'})) {
if (defined(my $expiry = $system->{'file.config'}->{'plugin.radius'}->{'expiry_period'})) {
$logger->log(LOG_INFO,"[RADIUS] Set expiry_period to '%s'",$expiry);
$config->{'expiry_period'} = $expiry;
}
# Check if we got a username to pool transform
if (defined(my $userPoolTransform = $globals->{'file.config'}->{'plugin.radius'}->{'username_to_pool_transform'})) {
if (defined(my $userPoolTransform = $system->{'file.config'}->{'plugin.radius'}->{'username_to_pool_transform'})) {
$logger->log(LOG_INFO,"[RADIUS] Set username_to_pool_transform to '%s'",$userPoolTransform);
$config->{'username_to_pool_transform'} = $userPoolTransform;
}
# Default interface group to use
if (defined(my $interfaceGroup = $globals->{'file.config'}->{'plugin.radius'}->{'default_interface_group'})) {
if (defined(my $interfaceGroup = $system->{'file.config'}->{'plugin.radius'}->{'default_interface_group'})) {
if (isInterfaceGroupIDValid($interfaceGroup)) {
$logger->log(LOG_INFO,"[RADIUS] Set interface_group to '%s'",$interfaceGroup);
$config->{'interface_group'} = $interfaceGroup;
......@@ -169,7 +174,7 @@ sub plugin_init
}
# Default match priority to use
if (defined(my $matchPriority = $globals->{'file.config'}->{'plugin.radius'}->{'default_match_priority'})) {
if (defined(my $matchPriority = $system->{'file.config'}->{'plugin.radius'}->{'default_match_priority'})) {
if (isMatchPriorityIDValid($matchPriority)) {
$logger->log(LOG_INFO,"[RADIUS] Set match_priority to '%s'",$matchPriority);
$config->{'match_priority'} = $matchPriority;
......@@ -179,7 +184,7 @@ sub plugin_init
}
# Default traffic class to use
if (defined(my $trafficClassID = $globals->{'file.config'}->{'plugin.radius'}->{'default_traffic_class'})) {
if (defined(my $trafficClassID = $system->{'file.config'}->{'plugin.radius'}->{'default_traffic_class'})) {
if (isTrafficClassIDValid($trafficClassID)) {
$logger->log(LOG_INFO,"[RADIUS] Set traffic_class to '%s'",$trafficClassID);
$config->{'traffic_class'} = $trafficClassID;
......@@ -189,7 +194,7 @@ sub plugin_init
}
# Default group to use
if (defined(my $group = $globals->{'file.config'}->{'plugin.radius'}->{'default_group'})) {
if (defined(my $group = $system->{'file.config'}->{'plugin.radius'}->{'default_group'})) {
if (isGroupIDValid($group)) {
$logger->log(LOG_INFO,"[RADIUS] Set group to '%s'",$group);
$config->{'group'} = $group;
......@@ -211,6 +216,7 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
......@@ -218,6 +224,7 @@ sub plugin_start
}
# Initialize server
sub _session_start
{
......@@ -245,6 +252,7 @@ sub _session_start
}
# Shut down server
sub _session_stop
{
......@@ -258,7 +266,6 @@ sub _session_stop
# Blow everything away
$globals = undef;
$dictionary = undef;
$logger->log(LOG_DEBUG,"[RADIUS] Shutdown");
......@@ -266,6 +273,7 @@ sub _session_stop
}
# Read event for server
sub _session_socket_read
{
......@@ -285,7 +293,7 @@ sub _session_socket_read
my $peer_addr_h = inet_ntoa($peer_addr);
# Parse packet
my $pkt = opentrafficshaper::plugins::radius::Radius::Packet->new($dictionary,$udp_packet);
my $pkt = opentrafficshaper::plugins::radius::Radius::Packet->new($globals->{'Dictionary'},$udp_packet);
# Build log line
my $logLine = sprintf("Remote: %s:%s, Code: %s, Identifier: %s => ",$peer_addr_h,$peer_port,$pkt->code,$pkt->identifier);
......@@ -354,39 +362,70 @@ sub _session_socket_read
if (my $attrRawVal = $pkt->vsattr(IANA_PEN,'OpenTrafficShaper-Traffic-Limit')) {
$trafficLimit = @{ $attrRawVal }[0];
}
# Grab rate limits from the string we got
my $trafficLimitRx; my $trafficLimitTx;
my $trafficLimitRxBurst; my $trafficLimitTxBurst;
if (defined($trafficLimit)) {
# Match rx-rate[/tx-rate] rx-burst-rate[/tx-burst-rate]
if ($trafficLimit =~ /^(\d+)([km])(?:\/(\d+)([km]))?(?: (\d+)([km])(?:\/(\d+)([km]))?)?/) {
$trafficLimitRx = getKbit($1,$2);
$trafficLimitTx = getKbit($3,$4);
$trafficLimitRxBurst = getKbit($5,$6);
$trafficLimitTxBurst = getKbit($7,$8);
} else {
$logger->log(LOG_DEBUG,"[RADIUS] The 'OpenTrafficShaper-Traffic-Limit' attribute appears to be invalid for user '%s'".
": '%s'",
$username,
$trafficLimit
);
return;
# We assume below that we will have limits
if (!defined($trafficLimit)) {
$logger->log(LOG_NOTICE,"[RADIUS] No traffic limit set for user '%s', ignoring",$username);
return;
}
# Grab rate limits below from the string we got
my $rxCIR; my $txCIR;
my $rxLimit; my $txLimit;
# Match rx-rate[/tx-rate] rx-burst-rate[/tx-burst-rate]
if ($trafficLimit =~ /^(\d+)([km])(?:\/(\d+)([km]))?(?: (\d+)([km])(?:\/(\d+)([km]))?)?/) {
$rxCIR = getKbit($1,$2);
$txCIR = getKbit($3,$4);
$rxLimit = getKbit($5,$6);
$txLimit = getKbit($7,$8);
# Set our limits if they not defined
if (!defined($rxLimit)) {
$rxLimit = $rxCIR;
$rxCIR = $rxCIR / 4;
}
if (!defined($txLimit)) {
$txLimit = $txCIR;
$txCIR = $txCIR / 4;
}
} else {
$logger->log(LOG_WARN,"[RADIUS] The 'OpenTrafficShaper-Traffic-Limit' attribute appears to be invalid for user '%s'".
": '%s'",
$username,
$trafficLimit
);
return;
}
# Check if we have a pool transform
my $tPoolName;
my $poolName;
if (defined($config->{'username_to_pool_transform'})) {
# Check if transform matches, if it does set pool name
if ($username =~ $config->{'username_to_pool_transform'}) {
my $tPoolName = $1;
$poolName = $1;
}
}
# Check if the pool name is being overridden
if (my $attrRawVal = $pkt->vsattr(IANA_PEN,'OpenTrafficShaper-Traffic-Pool')) {
$poolName = @{ $attrRawVal }[0];
}
# If we got a pool name, check if it exists
if (defined($poolName)) {
if (!defined(getPoolByName($config->{'interface_group'},$poolName))) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' not found, using username '%s' instead",
$poolName,
$username
);
$poolName = $username;
}
# If we didn't get the pool name, just use the username
} else {
$poolName = $username;
}
# Check what to use for the pool name, by default its the username
my $poolName = $tPoolName || $username;
# Try grab the pool
my $pool = getPoolByName($poolName);
my $pool = getPoolByName($config->{'interface_group'},$poolName);
my $pid = defined($pool) ? $pool->{'ID'} : undef;
my $ipAddress = $pkt->attr('Framed-IP-Address');
......@@ -401,10 +440,10 @@ sub _session_socket_read
$config->{'match_priority'},
$group,
$trafficClassID,
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
# Check if user is new or online
......@@ -420,11 +459,14 @@ sub _session_socket_read
# Change the details
my $changes = changePool({
'ID' => $pid,
'ClassID' => $trafficClassID,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'FriendlyName' => $ipAddress,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'RxCIR' => $rxCIR,
# These MUST be defined
'TxLimit' => $txLimit,
'RxLimit' => $rxLimit,
'Expires' => $now + DEFAULT_EXPIRY_PERIOD
});
......@@ -450,12 +492,12 @@ sub _session_socket_read
# No pool, time to create one
} else {
# If we don't have rate limits, short circuit
if (!defined($trafficLimitTx)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'TrafficLimitTx', aborting",$poolName);
if (!defined($txCIR)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'TxCIR', aborting",$poolName);
return;
}
if (!defined($trafficLimitRx)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'TrafficLimitRx', aborting",$poolName);
if (!defined($rxCIR)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'RxCIR', aborting",$poolName);
return;
}
......@@ -464,11 +506,11 @@ sub _session_socket_read
'FriendlyName' => $ipAddress,
'Name' => $poolName,
'InterfaceGroupID' => $config->{'interface_group'},
'ClassID' => $trafficClassID,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'RxCIR' => $rxCIR,
'TxLimit' => $txLimit,
'RxLimit' => $rxLimit,
'Expires' => $now + $config->{'expiry_period'},
'Source' => "plugin.radius",
});
......@@ -507,6 +549,12 @@ sub _session_socket_read
);
}
# TODO: Add output of updated items here too?
changePool({
'ID' => $pid,
'FriendlyName' => $ipAddress
});
# If not display message
} else {
......@@ -529,6 +577,12 @@ sub _session_socket_read
'Expires' => $now + $config->{'expiry_period'},
'Source' => "plugin.radius",
});
# TODO: Add output of updated items here too?
changePool({
'ID' => $pid,
'FriendlyName' => $ipAddress
});
}
# Radius user going offline
......@@ -544,14 +598,20 @@ sub _session_socket_read
# If there is only 1 pool member, then lets expire the pool in the removal expiry period
if (@poolMembers == 1) {
$logger->log(LOG_INFO,"[RADIUS] Expiring pool '$poolName'");
changePool($pool->{'ID'},{ 'Expires' => $now + REMOVE_EXPIRY_PERIOD });
changePool({
'ID' => $pool->{'ID'},
'Expires' => $now + REMOVE_EXPIRY_PERIOD
});
}
}
# Check if we have a pool member with this username and IP
if (my $pmid = getPoolMemberByUsernameIP($pool->{'ID'},$username,$ipAddress)) {
$logger->log(LOG_INFO,"[RADIUS] Expiring pool '$poolName' member '$username'");
changePoolMember($pmid,{ 'Expires' => $now + REMOVE_EXPIRY_PERIOD });
changePoolMember({
'ID' => $pmid,
'Expires' => $now + REMOVE_EXPIRY_PERIOD
});
}
$logger->log(LOG_INFO,"[RADIUS] Pool '$poolName' member '$username' set to expire as they're offline");
......@@ -569,6 +629,7 @@ sub _session_socket_read
}
# Convert status into something easy to useful
sub getStatus
{
......@@ -586,16 +647,17 @@ sub getStatus
}
# Simple function to reduce everything to kbit
sub getKbit
{
my ($counter,$quantifier) = @_;
# If there is no counter
return undef if (!defined($counter));
return if (!defined($counter));
# We need a quantifier
return undef if (!defined($quantifier));
return if (!defined($quantifier));
# Initialize counter
my $newCounter = $counter;
......@@ -605,12 +667,13 @@ sub getKbit
} elsif ($quantifier =~ /^k$/i) {
$newCounter = $counter * 1;
} else {
return undef;
return;
}
return $newCounter;
}
1;
# vim: ts=4
opentrafficshaper/plugins/statistics/statistics.pm
View file @ efc9ebe1
# OpenTrafficShaper Traffic shaping statistics
# Copyright (C) 2007-2014, AllWorldIT
# 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
......@@ -21,17 +21,18 @@ package opentrafficshaper::plugins::statistics;
use strict;
use warnings;
use DBI;
use Data::Dumper;
use POE;
use Storable qw( dclone );
use awitpt::db::dblayer;
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use opentrafficshaper::plugins::configmanager qw(
getPool
getPools
getPoolMembers
getPoolTxInterface
getPoolRxInterface
......@@ -67,16 +68,100 @@ our (@ISA,@EXPORT,@EXPORT_OK);
use constant {
VERSION => '0.2.2',
# How often our config check ticks
TICK_PERIOD => 5,
TICK_PERIOD => 2,
STATISTICS_PERIOD => 60,
STATISTICS_PERIOD => 5,
STATISTICS_DIR_TX => 1,
STATISTICS_DIR_RX => 2,
STATISTICS_MAXFLUSH_PER_PERIOD => 10000,
# SQL Statements
SQL_ADD_IDENTIFIER => 'INSERT INTO identifiers (`Identifier`) VALUES (?)',
SQL_GET_IDENTIFIER => 'SELECT ID FROM identifiers WHERE `Identifier` = ?',
SQL_CONSOLIDATE_STATS => '
SELECT
`IdentifierID`, `Timestamp` - (`Timestamp` % ?) AS Timestamp,
`Direction`,
MAX(`CIR`) AS `CIR`, MAX(`Limit`) AS `Limit`, MAX(`Rate`) AS `Rate`, MAX(`PPS`) AS `PPS`,
MAX(`QueueLen`) AS `QueueLen`, MAX(`TotalBytes`) AS `TotalBytes`, MAX(`TotalPackets`) AS `TotalPackets`,
MAX(`TotalOverLimits`) AS `TotalOverLimits`, MAX(`TotalDropped`) AS `TotalDropped`
FROM
stats
WHERE
`Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
GROUP BY
`IdentifierID`, `Timestamp`, `Direction`
',
SQL_CONSOLIDATE_STATS_BASIC => '
SELECT
`IdentifierID`, `Timestamp` - (`Timestamp` % ?) AS Timestamp,
MAX(`Counter`) AS `Counter`
FROM
stats_basic
WHERE
`Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
GROUP BY
`IdentifierID`, `Timestamp`
',
SQL_GET_STATS => '
SELECT
`Timestamp`, `Direction`, `Rate`, `PPS`, `CIR`, `Limit`
FROM
stats
WHERE
`IdentifierID` = ?
AND `Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
',
SQL_GET_STATS_BASIC => '
SELECT
`Timestamp`, `Counter`
FROM
stats_basic
WHERE
`IdentifierID` = ?
AND `Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
',
SQL_CLEANUP_STATS => 'DELETE FROM stats WHERE `Key` = ? AND `Timestamp` < ?',
SQL_CLEANUP_STATS_BASIC => 'DELETE FROM stats_basic WHERE `Key` = ? AND `Timestamp` < ?'
};
sub STATS_CONFIG
{
{
1 => {
'precision' => 300, # 5min
'retention' => 4, # 4 days
},
2 => {
'precision' => 900, # 15min
'retention' => 14, # 14 days
},
3 => {
'precision' => 3600, # 1hr
'retention' => 28 * 2, # 2 months
},
4 => {
'precision' => 21600, # 6hr
'retention' => 28 * 6, # 6 months
},
5 => {
'precision' => 86400, # 24hr
'retention' => 28 * 12 * 2, # 2 years
}
}
}
# Plugin info
our $pluginInfo = {
......@@ -92,55 +177,30 @@ our $pluginInfo = {
my $globals;
my $logger;
# Our configuration
my $config = {
'db_dsn' => undef,
'db_username' => "",
'db_password' => "",
};
# Stats configuration
my $statsConfig = {
1 => {
'precision' => 300, # 5min
'retention' => 4, # 4 days
},
2 => {
'precision' => 900, # 15min
'retention' => 14, # 14 days
},
3 => {
'precision' => 3600, # 1hr
'retention' => 28 * 2, # 2 months
},
4 => {
'precision' => 21600, # 6hr
'retention' => 28 * 6, # 6 months
},
5 => {
'precision' => 86400, # 24hr
'retention' => 28 * 12 * 2, # 2 years
}
};
# Handle of DBI
#
# $globals->{'Database'}->{'Handle'}
# $globals->{'Database'}->{'DSN'}
# $globals->{'Database'}->{'Username'}
# $globals->{'Database'}->{'Password'}
# DB identifier map
#
# $globals->{'IdentifierMap'}
# Handle of DBI
my $dbh;
# DB user mappings
my $statsDBIdentifierMap = { };
# Stats queue
my $statsQueue = [ ];
#
# $globals->{'StatsQueue'}
# $globals->{'LastCleanup'}
# $globals->{'LastConfigManagerStats'}
# Stats subscribers & counter
my $sidSubscribers = {};
my $ssidMap = {};
my $ssidCounter = 0;
my @ssidCounterFreeList = ();
# Prepared statements we need...
my $statsPreparedStatements = { };
# Last cleanup time
my $lastCleanup = { };
# Last config manager stats pull
my $lastConfigManagerStats = 0;
# $globals->{'SIDSubscribers'}
# $globals->{'SSIDMap'}
# $globals->{'SSIDCounter'}
# $globals->{'SSIDCounterFreeList'}
# Initialize plugin
......@@ -154,21 +214,36 @@ sub plugin_init
$logger->log(LOG_NOTICE,"[STATISTICS] OpenTrafficShaper Statistics v%s - Copyright (c) 2007-2014, AllWorldIT",VERSION);
# Initialize
$globals->{'Database'} = undef;
$globals->{'IdentifierMap'} = { };
$globals->{'StatsQueue'} = [ ];
$globals->{'LastCleanup'} = { };
$globals->{'LastConfigManagerStats'} = { };
$globals->{'SIDSubscribers'} = { };
$globals->{'SSIDMap'} = { };
$globals->{'SSIDCounter'} = 0;
$globals->{'SSIDCounterFreeList'} = [ ];
# Check our interfaces
if (defined(my $dbdsn = $globals->{'file.config'}->{'plugin.statistics'}->{'db_dsn'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set db_dsn to '%s'",$dbdsn);
$config->{'db_dsn'} = $dbdsn;
$logger->log(LOG_INFO,"[STATISTICS] Set database DSN to '%s'",$dbdsn);
$globals->{'Database'}->{'DSN'} = $dbdsn;
if (defined(my $dbuser = $globals->{'file.config'}->{'plugin.statistics'}->{'db_username'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set database username to '%s'",$dbuser);
$globals->{'Database'}->{'Username'} = $dbuser;
}
if (defined(my $dbpass = $globals->{'file.config'}->{'plugin.statistics'}->{'db_password'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set database password to '%s'",$dbpass);
$globals->{'Database'}->{'Password'} = $dbpass;
}
} else {
$logger->log(LOG_WARN,"[STATISTICS] No db_dsn to specified in configuration file. Stats storage disabled!");
}
if (defined(my $dbuser = $globals->{'file.config'}->{'plugin.statistics'}->{'db_username'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set db_username to '%s'",$dbuser);
$config->{'db_username'} = $dbuser;
}
if (defined(my $dbpass = $globals->{'file.config'}->{'plugin.statistics'}->{'db_password'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set db_password to '%s'",$dbpass);
$config->{'db_password'} = $dbpass;
$logger->log(LOG_WARN,"[STATISTICS] No database DSN to specified in configuration file. Stats storage disabled!");
}
# This is our main stats session
......@@ -184,108 +259,39 @@ sub plugin_init
);
# Create DBI agent
if (defined($config->{'db_dsn'})) {
$dbh = DBI->connect(
$config->{'db_dsn'}, $config->{'db_username'}, $config->{'db_password'},
{
'AutoCommit' => 1,
'RaiseError' => 0,
'FetchHashKeyName' => 'NAME_lc'
}
);
if (!defined($dbh)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to connect to database: %s",$DBI::errstr);
}
# Prepare identifier add statement
if ($dbh && (my $res = $dbh->prepare('INSERT INTO identifiers (`Identifier`) VALUES (?)'))) {
$statsPreparedStatements->{'identifier_add'} = $res;
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'identifier_add': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
}
# Prepare identifier get statement
if ($dbh && (my $res = $dbh->prepare('SELECT ID FROM identifiers WHERE `Identifier` = ?'))) {
$statsPreparedStatements->{'identifier_get'} = $res;
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'identifier_get': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
}
# Prepare stats consolidation statements
if ($dbh && (my $res = $dbh->prepare('
SELECT
`IdentifierID`, `Timestamp` - (`Timestamp` % ?) AS TimestampM,
`Direction`,
MAX(`CIR`) AS `CIR`, MAX(`Limit`) AS `Limit`, MAX(`Rate`) AS `Rate`, MAX(`PPS`) AS `PPS`,
MAX(`Queue_Len`) AS `Queue_Len`, AVG(`Total_Bytes`) AS `Total_Bytes`, AVG(`Total_Packets`) AS `Total_Packets`,
AVG(`Total_Overlimits`) AS `Total_Overlimits`, AVG(`Total_Dropped`) AS `Total_Dropped`
FROM
stats
WHERE
`Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
GROUP BY
`IdentifierID`, `TimestampM`, `Direction`
'))) {
$statsPreparedStatements->{'stats_consolidate'} = $res;
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'stats_consolidate': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
}
if ($dbh && (my $res = $dbh->prepare('
SELECT
`IdentifierID`, `Timestamp` - (`Timestamp` % ?) AS TimestampM,
MAX(`Counter`) AS `Counter`
FROM
stats_basic
WHERE
`Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
GROUP BY
`IdentifierID`, `TimestampM`
'))) {
$statsPreparedStatements->{'stats_basic_consolidate'} = $res;
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'stats_basic_consolidate': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
}
# Prepare stats cleanup statements
if ($dbh && (my $res = $dbh->prepare('DELETE FROM stats WHERE `Key` = ? AND `Timestamp` < ?'))) {
$statsPreparedStatements->{'stats_cleanup'} = $res;
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'stats_cleanup': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
}
if ($dbh && (my $res = $dbh->prepare('DELETE FROM stats_basic WHERE `Key` = ? AND `Timestamp` < ?'))) {
$statsPreparedStatements->{'stats_basic_cleanup'} = $res;
if (defined($globals->{'Database'})) {
$globals->{'Database'}->{'Handle'} = DBInit($globals->{'Database'});
# Check if handle is defined
if (defined($globals->{'Database'}->{'Handle'})) {
# Try connect (0 is success)
if (!DBConnect()) {
$logger->log(LOG_INFO,"[STATISTICS] Connected to database");
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to connect to database: %s (DATABASE DISABLED)",
awitpt::db::dblayer::Error());
# Don't try again
delete($globals->{'Database'});
}
# If the handle is not defined, the database won't work
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to prepare statement 'stats_basic_cleanup': %s",$DBI::errstr);
$dbh->disconnect();
$dbh = undef;
$logger->log(LOG_ERR,"[STATISTICS] Failed to initailize database: %s (DATABASE DISABLED)",
awitpt::db::dblayer::Error());
}
# Set last cleanup to now
my $now = time();
foreach my $key (keys %{$statsConfig}) {
foreach my $key (keys %{STATS_CONFIG()}) {
# Get aligned time so we cleanup sooner
$lastCleanup->{$key} = _getAlignedTime($now,$statsConfig->{$key}->{'precision'});
$globals->{'LastCleanup'}->{$key} = _getAlignedTime($now,STATS_CONFIG()->{$key}->{'precision'});
}
$lastConfigManagerStats = $now;
$globals->{'LastConfigManagerStats'} = $now;
}
return 1;
}
# Start the plugin
sub plugin_start
{
......@@ -294,6 +300,7 @@ sub plugin_start
}
# Initialize this plugins main POE session
sub _session_start
{
......@@ -310,6 +317,7 @@ sub _session_start
}
# Stop session
sub _session_stop
{
......@@ -321,18 +329,6 @@ sub _session_stop
# Tear down data
$globals = undef;
$dbh = undef;
$statsDBIdentifierMap = { };
$statsQueue = [ ];
$sidSubscribers = {};
$ssidMap = {};
$ssidCounter = 0;
@ssidCounterFreeList = ();
$statsPreparedStatements = { };
$lastCleanup = { };
$lastConfigManagerStats = 0;
$logger->log(LOG_DEBUG,"[STATISTICS] Shutdown");
......@@ -340,28 +336,23 @@ sub _session_stop
}
# Time ticker for processing changes
sub _session_tick
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# If we don't have a DB handle, just skip...
if (!$dbh) {
# If we don't have a database, just skip...
if (!$globals->{'Database'}) {
return;
}
my $now = time();
my $timer1 = [gettimeofday];
# Pull in statements
my $sthStatsConsolidate = $statsPreparedStatements->{'stats_consolidate'};
my $sthStatsCleanup = $statsPreparedStatements->{'stats_cleanup'};
my $sthStatsBasicConsolidate = $statsPreparedStatements->{'stats_basic_consolidate'};
my $sthStatsBasicCleanup = $statsPreparedStatements->{'stats_basic_cleanup'};
# Even out flushing over 10s to absorb spikes
my $totalFlush = @{$statsQueue};
my $totalFlush = @{$globals->{'StatsQueue'}};
my $maxFlush = int($totalFlush / 10) + 100;
my $numFlush = 0;
......@@ -373,22 +364,22 @@ sub _session_tick
# Loop and build the data to create our multi-insert
my (@insertHolders,@insertBasicHolders);
my (@insertData,@insertBasicData);
while (defined(my $stat = shift(@{$statsQueue})) && $numFlush < $maxFlush) {
while (defined(my $stat = shift(@{$globals->{'StatsQueue'}})) && $numFlush < $maxFlush) {
# This is a basic counter
if (defined($stat->{'counter'})) {
if (defined($stat->{'Counter'})) {
push(@insertBasicHolders,"(?,?,?,?)");
push(@insertBasicData,
$stat->{'identifierid'}, $stat->{'key'}, $stat->{'timestamp'},
$stat->{'counter'}
$stat->{'IdentifierID'}, $stat->{'Key'}, $stat->{'Timestamp'},
$stat->{'Counter'}
);
# Full stats counter
} else {
push(@insertHolders,"(?,?,?,?,?,?,?,?,?,?,?,?,?)");
push(@insertData,
$stat->{'identifierid'}, $stat->{'key'}, $stat->{'timestamp'},
$stat->{'direction'},
$stat->{'cir'}, $stat->{'limit'}, $stat->{'rate'}, $stat->{'pps'}, $stat->{'queue_len'},
$stat->{'total_bytes'}, $stat->{'total_packets'}, $stat->{'total_overlimits'}, $stat->{'total_dropped'}
$stat->{'IdentifierID'}, $stat->{'Key'}, $stat->{'Timestamp'},
$stat->{'Direction'},
$stat->{'CIR'}, $stat->{'Limit'}, $stat->{'Rate'}, $stat->{'PPS'}, $stat->{'QueueLen'},
$stat->{'TotalBytes'}, $stat->{'TotalPackets'}, $stat->{'TotalOverLimits'}, $stat->{'TotalDropped'}
);
}
......@@ -397,36 +388,36 @@ sub _session_tick
# If we got things to insert, do it
if (@insertBasicHolders > 0) {
my $res = $dbh->do('
INSERT DELAYED INTO stats_basic
my $res = DBDo('
INSERT INTO stats_basic
(
`IdentifierID`, `Key`, `Timestamp`,
`Counter`
)
VALUES
'.join(',',@insertBasicHolders),undef,@insertBasicData
'.join(',',@insertBasicHolders),@insertBasicData
);
# Check for error
if (!defined($res)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute delayed stats_basic insert: %s",$DBI::errstr);
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic insert: %s",awitpt::db::dblayer::Error());
}
}
# And normal stats...
if (@insertHolders > 0) {
my $res = $dbh->do('
INSERT DELAYED INTO stats
my $res = DBDo('
INSERT INTO stats
(
`IdentifierID`, `Key`, `Timestamp`,
`Direction`,
`CIR`, `Limit`, `Rate`, `PPS`, `Queue_Len`,
`Total_Bytes`, `Total_Packets`, `Total_Overlimits`, `Total_Dropped`
`CIR`, `Limit`, `Rate`, `PPS`, `QueueLen`,
`TotalBytes`, `TotalPackets`, `TotalOverLimits`, `TotalDropped`
)
VALUES
'.join(',',@insertHolders),undef,@insertData
'.join(',',@insertHolders),@insertData
);
# Check for error
if (!defined($res)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute delayed stats insert: %s",$DBI::errstr);
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats insert: %s",awitpt::db::dblayer::Error());
}
}
......@@ -435,24 +426,24 @@ sub _session_tick
if ($numFlush) {
my $timediff2 = tv_interval($timer1,$timer2);
$logger->log(LOG_INFO,"[STATISTICS] Total stats flush time %s/%s records: %s",
$numFlush,
$totalFlush,
sprintf('%.3fs',$timediff2)
$numFlush,
$totalFlush,
sprintf('%.3fs',$timediff2)
);
}
my $res;
# Loop with our stats consolidation configuration
foreach my $key (sort keys %{$statsConfig}) {
foreach my $key (sort keys %{STATS_CONFIG()}) {
my $timerA = [gettimeofday];
my $precision = $statsConfig->{$key}->{'precision'};
my $precision = STATS_CONFIG()->{$key}->{'precision'};
my $thisPeriod = _getAlignedTime($now,$precision);
my $lastPeriod = $thisPeriod - $precision;
my $prevKey = $key - 1;
# If we havn't exited the last period, then skip
if ($lastCleanup->{$key} > $lastPeriod) {
if ($globals->{'LastCleanup'}->{$key} > $lastPeriod) {
next;
}
......@@ -464,59 +455,61 @@ sub _session_tick
my $consolidateUpTo = $lastPeriod - $precision;
# Execute and pull in consolidated stats
$res = $sthStatsBasicConsolidate->execute($precision,$prevKey,$consolidateFrom,$consolidateUpTo);
$res = DBSelect(SQL_CONSOLIDATE_STATS_BASIC,$precision,$prevKey,$consolidateFrom,$consolidateUpTo);
if ($res) {
# Loop with items returned
while (my $item = $sthStatsBasicConsolidate->fetchrow_hashref()) {
$item->{'key'} = $key;
$item->{'timestamp'} = $item->{'timestampm'};
while (my $item = hashifyLCtoMC($res->fetchrow_hashref(),'IdentifierID','Timestamp','Counter')) {
$item->{'Key'} = $key;
# Queue for insert
push(@{$statsQueue},$item);
push(@{$globals->{'StatsQueue'}},$item);
$numStatsBasicConsolidated++;
}
DBFreeRes($res);
# If there was an error, make sure we report it
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic consolidation statement: %s",
$sthStatsBasicConsolidate->errstr()
);
awitpt::db::dblayer::Error());
}
# And the normal stats...
$res = $sthStatsConsolidate->execute($precision,$prevKey,$consolidateFrom,$consolidateUpTo);
$res = DBSelect(SQL_CONSOLIDATE_STATS,$precision,$prevKey,$consolidateFrom,$consolidateUpTo);
if ($res) {
# Loop with items returned
while (my $item = $sthStatsConsolidate->fetchrow_hashref()) {
$item->{'key'} = $key;
$item->{'timestamp'} = $item->{'timestampm'};
while (my $item = hashifyLCtoMC(
$res->fetchrow_hashref(),
'IdentifierID','Timestamp','Direction','CIR','Limit','Rate','PPS','QueueLen','TotalBytes','TotalPackets',
'TotalOverLimits','TotalDropped'
)) {
$item->{'Key'} = $key;
# Queue for insert
push(@{$statsQueue},$item);
push(@{$globals->{'StatsQueue'}},$item);
$numStatsConsolidated++;
}
DBFreeRes($res);
# If there was an error, make sure we report it
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats consolidation statement: %s",
$sthStatsConsolidate->errstr()
);
awitpt::db::dblayer::Error());
}
# Set last cleanup to now
$lastCleanup->{$key} = $now;
$globals->{'LastCleanup'}->{$key} = $now;
my $timerB = [gettimeofday];
my $timediffB = tv_interval($timerA,$timerB);
$logger->log(LOG_INFO,"[STATISTICS] Stats consolidation: key %s in %s (%s basic, %s normal), period %s - %s [%s - %s]",
$key,
sprintf('%.3fs',$timediffB),
$numStatsBasicConsolidated,
$numStatsConsolidated,
$consolidateFrom,
$consolidateUpTo,
scalar(localtime($consolidateFrom)),
scalar(localtime($consolidateUpTo))
$key,
sprintf('%.3fs',$timediffB),
$numStatsBasicConsolidated,
$numStatsConsolidated,
$consolidateFrom,
$consolidateUpTo,
scalar(localtime($consolidateFrom)),
scalar(localtime($consolidateUpTo))
);
}
......@@ -526,117 +519,116 @@ sub _session_tick
# We only need to run as often as the first precision
# - If cleanup has not yet run?
# - or if the 0 cleanup plus precision of the first key is in the past (data is now stale?)
if (!defined($lastCleanup->{'0'}) || $lastCleanup->{'0'} + $statsConfig->{1}->{'precision'} < $now) {
if (!defined($globals->{'LastCleanup'}->{'0'}) || $globals->{'LastCleanup'}->{'0'} + STATS_CONFIG()->{1}->{'precision'} < $now) {
# We're going to clean up for the first stats precision * 3, which should be enough
my $cleanUpTo = $now - ($statsConfig->{1}->{'precision'} * 3);
my $cleanUpTo = $now - (STATS_CONFIG()->{1}->{'precision'} * 3);
# Streamed stats is removed 3 time periods past the first precision
my $timerA = [gettimeofday];
if ($res = $sthStatsBasicCleanup->execute(0, $cleanUpTo)) {
if ($res = DBDo(SQL_CLEANUP_STATS_BASIC,0,$cleanUpTo)) {
my $timerB = [gettimeofday];
my $timerdiffA = tv_interval($timerA,$timerB);
# We get 0E0 for 0 when none were removed
if ($res ne "0E0") {
$logger->log(LOG_INFO,"[STATISTICS] Cleanup streamed stats_basic, %s items in %s, up to %s [%s]",
$res,
sprintf('%.3fs',$timerdiffA),
$cleanUpTo,
scalar(localtime($cleanUpTo)),
$res,
sprintf('%.3fs',$timerdiffA),
$cleanUpTo,
scalar(localtime($cleanUpTo)),
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic cleanup statement: %s",
$sthStatsBasicCleanup->errstr()
);
awitpt::db::dblayer::Error());
}
# And the normal stats...
$timerA = [gettimeofday];
if ($res = $sthStatsCleanup->execute(0, $cleanUpTo)) {
if ($res = DBDo(SQL_CLEANUP_STATS,0,$cleanUpTo)) {
my $timerB = [gettimeofday];
my $timerdiffA = tv_interval($timerA,$timerB);
# We get 0E0 for 0 when none were removed
if ($res ne "0E0") {
$logger->log(LOG_INFO,"[STATISTICS] Cleanup streamed stats, %s items in %s, up to %s [%s]",
$res,
sprintf('%.3fs',$timerdiffA),
$cleanUpTo,scalar(localtime($cleanUpTo))
$res,
sprintf('%.3fs',$timerdiffA),
$cleanUpTo,scalar(localtime($cleanUpTo))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats cleanup statement: %s",
$sthStatsCleanup->errstr()
awitpt::db::dblayer::Error()
);
}
# Loop and remove retained stats
foreach my $key (keys %{$statsConfig}) {
foreach my $key (keys %{STATS_CONFIG()}) {
# Work out timestamp to clean up to by multiplying the retention period by days
$cleanUpTo = $now - ($statsConfig->{$key}->{'retention'} * 86400);
$cleanUpTo = $now - (STATS_CONFIG()->{$key}->{'retention'} * 86400);
# Retention period is in # days
my $timerA = [gettimeofday];
if ($res = $sthStatsBasicCleanup->execute($key, $cleanUpTo)) {
if ($res = DBDo(SQL_CLEANUP_STATS_BASIC,$key,$cleanUpTo)) {
# We get 0E0 for 0 when none were removed
if ($res ne "0E0") {
my $timerB = [gettimeofday];
my $timerdiffA = tv_interval($timerA,$timerB);
$logger->log(LOG_INFO,"[STATISTICS] Cleanup stats_basic key %s in %s, %s items up to %s [%s]",
$key,
sprintf('%.3fs',$timerdiffA),
$res,
$cleanUpTo,
scalar(localtime($cleanUpTo))
$key,
sprintf('%.3fs',$timerdiffA),
$res,
$cleanUpTo,
scalar(localtime($cleanUpTo))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic cleanup statement for key %s: %s",
$key,
$sthStatsBasicCleanup->errstr()
$key,
awitpt::db::dblayer::Error()
);
}
# And normal stats...
$timerA = [gettimeofday];
if ($res = $sthStatsCleanup->execute($key, $cleanUpTo)) {
if ($res = DBDo(SQL_CLEANUP_STATS,$key,$cleanUpTo)) {
# We get 0E0 for 0 when none were removed
if ($res ne "0E0") {
my $timerB = [gettimeofday];
my $timerdiffA = tv_interval($timerA,$timerB);
$logger->log(LOG_INFO,"[STATISTICS] Cleanup stats key %s in %s, %s items up to %s [%s]",
$key,
sprintf('%.3fs',$timerdiffA),
$res,
$cleanUpTo,
scalar(localtime($cleanUpTo))
$key,
sprintf('%.3fs',$timerdiffA),
$res,
$cleanUpTo,
scalar(localtime($cleanUpTo))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats cleanup statement for key %s: %s",
$key,
$sthStatsCleanup->errstr()
$key,
awitpt::db::dblayer::Error()
);
}
}
# Set last main cleanup to now
$lastCleanup->{'0'} = $now;
$globals->{'LastCleanup'}->{'0'} = $now;
my $timer4 = [gettimeofday];
my $timediff4 = tv_interval($timer3,$timer4);
$logger->log(LOG_INFO,"[STATISTICS] Total stats cleanup time: %s",
sprintf('%.3fs',$timediff4)
sprintf('%.3fs',$timediff4)
);
}
# Check if we need to pull config manager stats
if ($now - $lastConfigManagerStats > STATISTICS_PERIOD) {
if ($now - $globals->{'LastConfigManagerStats'} > STATISTICS_PERIOD) {
my $configManagerStats = _getConfigManagerStats();
_processStatistics($kernel,$configManagerStats);
$lastConfigManagerStats = $now;
$globals->{'LastConfigManagerStats'} = $now;
}
# Set delay on config updates
......@@ -644,6 +636,7 @@ sub _session_tick
}
# Update limit Statistics
# $item has some special use cases:
# main:$iface:all - Interface total stats
......@@ -654,15 +647,11 @@ sub _session_update
my ($kernel, $statsData) = @_[KERNEL, ARG0];
# TODO? This requires DB access
if (!$dbh) {
return;
}
_processStatistics($kernel,$statsData);
}
# Handle subscriptions to updates
sub subscribe
{
......@@ -670,24 +659,24 @@ sub subscribe
$logger->log(LOG_INFO,"[STATISTICS] Got subscription request for '%s': handler='%s', event='%s'",
$sid,
$handler,
$event
$sid,
$handler,
$event
);
# Grab next SSID
my $ssid = shift(@ssidCounterFreeList);
my $ssid = shift(@{$globals->{'SSIDCounterFreeList'}});
if (!defined($ssid)) {
$ssid = $ssidCounter++;
$ssid = $globals->{'SSIDCounter'}++;
}
# Setup data and conversions
$ssidMap->{$ssid} = $sidSubscribers->{$sid}->{$ssid} = {
'sid' => $sid,
'ssid' => $ssid,
'conversions' => $conversions,
'handler' => $handler,
'event' => $event
$globals->{'SSIDMap'}->{$ssid} = $globals->{'SIDSubscribers'}->{$sid}->{$ssid} = {
'SID' => $sid,
'SSID' => $ssid,
'Conversions' => $conversions,
'Handler' => $handler,
'Event' => $event
};
# Return the SID we subscribed
......@@ -695,6 +684,7 @@ sub subscribe
}
# Handle unsubscribes
sub unsubscribe
{
......@@ -702,32 +692,33 @@ sub unsubscribe
# Grab item, and check if it doesnt exist
my $item = $ssidMap->{$ssid};
my $item = $globals->{'SSIDMap'}->{$ssid};
if (!defined($item)) {
$logger->log(LOG_ERR,"[STATISTICS] Got unsubscription request for SSID '%s' that doesn't exist",
$ssid
$ssid
);
return
}
$logger->log(LOG_INFO,"[STATISTICS] Got unsubscription request for SSID '%s'",
$ssid
$ssid
);
# Remove subscriber
delete($sidSubscribers->{$item->{'sid'}}->{$ssid});
delete($globals->{'SIDSubscribers'}->{$item->{'SID'}}->{$ssid});
# If SID is now empty, remove it too
if (! keys %{$sidSubscribers->{$item->{'sid'}}}) {
delete($sidSubscribers->{$item->{'sid'}});
if (! keys %{$globals->{'SIDSubscribers'}->{$item->{'SID'}}}) {
delete($globals->{'SIDSubscribers'}->{$item->{'SID'}});
}
# Remove mapping
delete($ssidMap->{$ssid});
delete($globals->{'SSIDMap'}->{$ssid});
# Push onto list of free ID's
push(@ssidCounterFreeList,$ssid);
push(@{$globals->{'SSIDCounterFreeList'}},$ssid);
}
# Return user last stats
sub getLastStats
{
......@@ -759,13 +750,14 @@ sub getLastStats
}
# Return stats by SID
sub getStatsBySID
{
my ($sid,$conversions) = @_;
my ($sid,$conversions,$startTimestamp,$endTimestamp) = @_;
my $statistics = _getStatsBySID($sid);
my $statistics = _getStatsBySID($sid,$startTimestamp,$endTimestamp);
if (!defined($statistics)) {
return;
}
......@@ -781,6 +773,7 @@ sub getStatsBySID
}
# Return basic stats by SID
sub getStatsBasicBySID
{
......@@ -803,6 +796,7 @@ sub getStatsBasicBySID
}
# Get the stats ID from Class ID
sub getSIDFromCID
{
......@@ -812,7 +806,7 @@ sub getSIDFromCID
# Grab identifier based on class ID
my $identifier = _getIdentifierFromCID($iface,$cid);
if (!defined($identifier)) {
return undef;
return;
}
# Return the SID fo the identifier
......@@ -820,6 +814,7 @@ sub getSIDFromCID
}
# Set the stats ID from Class ID
sub setSIDFromCID
{
......@@ -832,7 +827,7 @@ sub setSIDFromCID
# If not, grab the identifier
my $identifier = _getIdentifierFromCID($iface,$cid);
if (!defined($identifier)) {
return undef;
return;
}
# And setup a new SID
$sid = _setSIDFromIdentifier($identifier);
......@@ -842,6 +837,7 @@ sub setSIDFromCID
}
# Get the stats ID from a PID
sub getSIDFromPID
{
......@@ -851,7 +847,7 @@ sub getSIDFromPID
# Grab identifier from a PID
my $identifier = _getIdentifierFromPID($pid);
if (!defined($identifier)) {
return undef;
return;
}
# Return the SID for the PID
......@@ -871,7 +867,7 @@ sub setSIDFromPID
# If we can't, grab the identifier instead
my $identifier = _getIdentifierFromPID($pid);
if (!defined($identifier)) {
return undef;
return;
}
# And setup the SID
$sid = _setSIDFromIdentifier($identifier);
......@@ -881,6 +877,7 @@ sub setSIDFromPID
}
# Get the stats ID from a counter
sub getSIDFromCounter
{
......@@ -890,7 +887,7 @@ sub getSIDFromCounter
# Grab identifier from a counter
my $identifier = _getIdentifierFromCounter($counter);
if (!defined($identifier)) {
return undef;
return;
}
# Return the SID for the counter
......@@ -898,6 +895,7 @@ sub getSIDFromCounter
}
# Set the stats ID from a counter
sub setSIDFromCounter
{
......@@ -910,7 +908,7 @@ sub setSIDFromCounter
# If we can't, grab the identifier instead
my $identifier = _getIdentifierFromCounter($counter);
if (!defined($identifier)) {
return undef;
return;
}
# And setup the SID
$sid = _setSIDFromIdentifier($identifier);
......@@ -920,6 +918,7 @@ sub setSIDFromCounter
}
# Return traffic direction
sub getTrafficDirection
{
......@@ -937,31 +936,44 @@ sub getTrafficDirection
return STATISTICS_DIR_RX;
}
return undef;
return;
}
# Generate ConfigManager counters
sub getConfigManagerCounters
{
my @poolList = getPools();
my $classes = getAllTrafficClasses();
my @classes = getAllTrafficClasses();
# Grab user count
my %counters;
$counters{"configmanager.totalpools"} = @poolList;
# Zero this counter
$counters{"configmanager.totalpoolmembers"} = 0;
# Zero the number of pools in each class to start off with
foreach my $cid (keys %{$classes}) {
foreach my $cid (@classes) {
$counters{"configmanager.classpools.$cid"} = 0;
$counters{"configmanager.classpoolmembers.$cid"} = 0;
}
# Pull in each pool and bump up the class counter
foreach my $pid (@poolList) {
my $pool = getPool($pid);
my $cid = getPoolTrafficClassID($pid);
# Bump the class counter
my @poolMembers = getPoolMembers($pid);
# Bump the class counters
$counters{"configmanager.classpools.$cid"}++;
$counters{"configmanager.classpoolmembers.$cid"} += @poolMembers;
# Bump the pool member counter
$counters{"configmanager.totalpoolmembers"} += @poolMembers;
# Set pool member count
$counters{"configmanager.poolmembers.$pool->{'InterfaceGroupID'}/$pool->{'Name'}"} = @poolMembers;
}
return \%counters;
......@@ -972,6 +984,7 @@ sub getConfigManagerCounters
# Internal Functions
#
# Function to process a bunch of statistics
sub _processStatistics
{
......@@ -983,37 +996,37 @@ sub _processStatistics
# Loop through stats data we got
while ((my $sid, my $stat) = each(%{$statsData})) {
$stat->{'identifierid'} = $sid;
$stat->{'key'} = 0;
$stat->{'IdentifierID'} = $sid;
$stat->{'Key'} = 0;
# Add to main queue
push(@{$statsQueue},$stat);
push(@{$globals->{'StatsQueue'}},$stat);
# Check if we have an event handler subscriber for this item
if (defined(my $subscribers = $sidSubscribers->{$sid})) {
if (defined(my $subscribers = $globals->{'SIDSubscribers'}->{$sid})) {
# Build the stat that our conversions understands
my $eventStat;
# This is a basic counter
if (defined($stat->{'counter'})) {
if (defined($stat->{'Counter'})) {
$eventStat = {
'counter' => $stat->{'counter'}
'counter' => $stat->{'Counter'}
};
} else {
$eventStat->{$stat->{'direction'}} = {
'rate' => $stat->{'rate'},
'pps' => $stat->{'pps'},
'cir' => $stat->{'cir'},
'limit' => $stat->{'limit'}
$eventStat->{$stat->{'Direction'}} = {
'rate' => $stat->{'Rate'},
'pps' => $stat->{'PPS'},
'cir' => $stat->{'CIR'},
'limit' => $stat->{'Limit'}
};
}
# If we do, loop with them
foreach my $ssid (keys %{$subscribers}) {
my $subscriber = $subscribers->{$ssid};
my $handler = $subscriber->{'handler'};
my $event = $subscriber->{'event'};
my $conversions = $subscriber->{'conversions'};
my $handler = $subscriber->{'Handler'};
my $event = $subscriber->{'Event'};
my $conversions = $subscriber->{'Conversions'};
# Get temp stat, this still refs the original one
my $tempStat;
......@@ -1024,7 +1037,7 @@ sub _processStatistics
$tempStat = _fixStatDirection($eventStat,$conversions);
}
# Send a copy! so we don't send refs to data used elsewhere
$queuedEvents->{$handler}->{$event}->{$ssid}->{$stat->{'timestamp'}} = dclone($tempStat);
$queuedEvents->{$handler}->{$event}->{$ssid}->{$stat->{'Timestamp'}} = dclone($tempStat);
}
}
}
......@@ -1040,6 +1053,7 @@ sub _processStatistics
}
# Generate ConfigManager stats
sub _getConfigManagerStats
{
......@@ -1053,9 +1067,9 @@ sub _getConfigManagerStats
foreach my $item (keys %{$counters}) {
my $identifierID = setSIDFromCounter($item);
my $stat = {
'identifierid' => $identifierID,
'timestamp' => $now,
'counter' => $counters->{$item}
'IdentifierID' => $identifierID,
'Timestamp' => $now,
'Counter' => $counters->{$item}
};
$statsData->{$identifierID} = $stat;
}
......@@ -1064,6 +1078,7 @@ sub _getConfigManagerStats
}
# Function to get a SID identifier from a class ID
sub _getIdentifierFromCID
{
......@@ -1074,6 +1089,7 @@ sub _getIdentifierFromCID
}
# Function to get a SID identifier from a pool ID
sub _getIdentifierFromPID
{
......@@ -1082,13 +1098,14 @@ sub _getIdentifierFromPID
my $pool = getPool($pid);
if (!defined($pool)) {
return undef;
return;
}
return sprintf("Pool:%s/%s",$pool->{'InterfaceGroupID'},$pool->{'Name'});
}
# Function to get a SID identifier from a counter
sub _getIdentifierFromCounter
{
......@@ -1098,16 +1115,18 @@ sub _getIdentifierFromCounter
}
# Return a cached SID if its cached
sub _getCachedSIDFromIdentifier
{
my $identifier = shift;
return $statsDBIdentifierMap->{$identifier};
return $globals->{'IdentifierMap'}->{$identifier};
}
# Grab or add the identifier to the DB
sub _getSIDFromIdentifier
{
......@@ -1119,39 +1138,51 @@ sub _getSIDFromIdentifier
return $sid;
}
# We need the DB to be alive to do this...
if (!defined($globals->{'Database'})) {
return;
}
# Try grab it from DB
my $identifierGetSTH = $statsPreparedStatements->{'identifier_get'};
if (my $res = $identifierGetSTH->execute($identifier)) {
if (my $res = DBSelect(SQL_GET_IDENTIFIER,$identifier)) {
# Grab first row and return
if (my $row = $identifierGetSTH->fetchrow_hashref()) {
return $statsDBIdentifierMap->{$identifier} = $row->{'id'};
if (my $row = $res->fetchrow_hashref()) {
DBFreeRes($res);
return $globals->{'IdentifierMap'}->{$identifier} = $row->{'id'};
}
DBFreeRes($res);
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to get SID from identifier '%s': %s",$identifier,$identifierGetSTH->errstr);
$logger->log(LOG_ERR,"[STATISTICS] Failed to get SID from identifier '%s': %s",$identifier,awitpt::db::dblayer::Error());
}
return undef;
return;
}
# Set SID from identifier in DB
sub _setSIDFromIdentifier
{
my $identifier = shift;
# We need the DB to be alive to do this...
if (!defined($globals->{'Database'})) {
return;
}
# Try add it to the DB
my $identifierAddSTH = $statsPreparedStatements->{'identifier_add'};
if (my $res = $identifierAddSTH->execute($identifier)) {
return $statsDBIdentifierMap->{$identifier} = $dbh->last_insert_id("","","","");
if (my $res = DBDo(SQL_ADD_IDENTIFIER,$identifier)) {
return $globals->{'IdentifierMap'}->{$identifier} = DBLastInsertID("","");
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to get SID from identifier '%s': %s",$identifier,$identifierAddSTH->errstr);
$logger->log(LOG_ERR,"[STATISTICS] Failed to set SID from identifier '%s': %s",$identifier,awitpt::db::dblayer::Error());
}
return undef;
return;
}
# Get aligned time on a Precision
sub _getAlignedTime
{
......@@ -1160,34 +1191,51 @@ sub _getAlignedTime
}
# Internal function to get stats by SID
sub _getStatsBySID
{
my $sid = shift;
my ($sid,$startTimestamp,$endTimestamp) = @_;
my $now = time();
# Prepare query
my $sth = $dbh->prepare('
SELECT
`Timestamp`, `Direction`, `Rate`, `PPS`, `CIR`, `Limit`
FROM
stats
WHERE
`IdentifierID` = ?
AND `Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
ORDER BY
`Timestamp` DESC
LIMIT 100
');
# Setup our timestamps if we need to
if (!defined($startTimestamp)) {
$startTimestamp = $now - 3600;
}
if (!defined($endTimestamp)) {
$endTimestamp = $now;
}
# Work out the timestamp
my $timespan = $endTimestamp - $startTimestamp;
# Find the best key to use...
my $statsKey = 0;
foreach my $key (sort {$b <=> $a} keys %{STATS_CONFIG()}) {
# Grab first key that will hve 50+ entries
if ($timespan / STATS_CONFIG()->{$key}->{'precision'} > 50) {
$statsKey = $key;
last;
}
}
my $statistics = { };
# We need the DB below this point
if (!defined($globals->{'Database'})) {
return $statistics;
}
# Grab last 60 mins of data
$sth->execute($sid,0,$now - 3600, $now);
my $res = DBSelect(SQL_GET_STATS,$sid,$statsKey,$startTimestamp,$endTimestamp);
if (!defined($res)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to get stats for SID '%s': %s",$sid,awitpt::db::dblayer::Error());
return $statistics;
}
my $statistics;
while (my $item = $sth->fetchrow_hashref()) {
while (my $item = $res->fetchrow_hashref()) {
$statistics->{$item->{'timestamp'}}->{$item->{'direction'}} = {
'rate' => $item->{'rate'},
'pps' => $item->{'pps'},
......@@ -1195,83 +1243,100 @@ sub _getStatsBySID
'limit' => $item->{'limit'},
}
}
DBFreeRes($res);
return $statistics;
}
# Internal function to get basic stats by SID
sub _getStatsBasicBySID
{
my $sid = shift;
my ($sid,$startTimestamp,$endTimestamp) = @_;
my $now = time();
# Setup our timestamps if we need to
if (!defined($startTimestamp)) {
$startTimestamp = $now - 3600;
}
if (!defined($endTimestamp)) {
$endTimestamp = $now;
}
# Work out the timestamp
my $timespan = $endTimestamp - $startTimestamp;
# Find the best key to use...
my $statsKey = 0;
foreach my $key (sort {$b <=> $a} keys %{STATS_CONFIG()}) {
# Grab first key that will hve 50+ entries
if ($timespan / STATS_CONFIG()->{$key}->{'precision'} > 50) {
$statsKey = $key;
last;
}
}
my $statistics = { };
# We need the DB below this point
if (!defined($globals->{'Database'})) {
return $statistics;
}
# Prepare query
my $sth = $dbh->prepare('
SELECT
`Timestamp`, `Counter`
FROM
stats_basic
WHERE
`IdentifierID` = ?
AND `Key` = ?
AND `Timestamp` > ?
AND `Timestamp` < ?
ORDER BY
`Timestamp` DESC
LIMIT 100
');
# Grab last 60 mins of data
$sth->execute($sid,0,$now - 3600, $now);
my $res = DBSelect(SQL_GET_STATS_BASIC,$sid,$statsKey,$startTimestamp,$endTimestamp);
my $statistics;
while (my $item = $sth->fetchrow_hashref()) {
while (my $item = $res->fetchrow_hashref()) {
$statistics->{$item->{'timestamp'}} = {
'counter' => $item->{'counter'},
}
}
DBFreeRes($res);
return $statistics;
}
# Function to transform stats before sending them
sub _fixStatDirection
{
my ($stat,$conversions) = @_;
# Pull in constants
my $tx = STATISTICS_DIR_TX; my $rx = STATISTICS_DIR_RX;
my $res;
# Depending which direction, grab the key to use below
my $oldStat;
my $oldKey;
if (defined($oldStat = $stat->{$tx})) {
$oldKey = 'tx';
} elsif (defined($oldStat = $stat->{$rx})) {
$oldKey = 'rx';
}
# Loop with directions, maybe we have more than one with this stat
while ((my $direction, my $oldStat) = each(%{$stat})) {
# Depending which direction, grab the key to use below
my $oldKey;
if ($direction == STATISTICS_DIR_TX) {
$oldKey = 'tx';
} elsif ($direction == STATISTICS_DIR_RX) {
$oldKey = 'rx';
}
# Loop and remove the direction, instead, adding it to the item
my $newStat;
foreach my $item (keys %{$oldStat}) {
# If we have conversions defined...
my $newKey;
if (defined($conversions) && defined($conversions->{'direction'})) {
$newKey = sprintf("%s.%s",$conversions->{'direction'},$item);
} else {
$newKey = sprintf("%s.%s",$oldKey,$item);
# Loop and remove the direction, instead, adding it to the item
foreach my $item (keys %{$oldStat}) {
# If we have conversions defined...
my $newKey;
if (defined($conversions) && defined($conversions->{'Direction'})) {
$newKey = sprintf("%s.%s",$conversions->{'Direction'},$item);
} else {
$newKey = sprintf("%s.%s",$oldKey,$item);
}
$res->{$newKey} = $oldStat->{$item};
}
$newStat->{$newKey} = $oldStat->{$item};
}
return $newStat;
return $res;
}
# Function to transform stats before sending them
sub _fixCounterName
{
......@@ -1283,8 +1348,8 @@ sub _fixCounterName
# If we have conversions defined...
my $newKey = 'counter';
if (defined($conversions) && defined($conversions->{'name'})) {
$newKey = sprintf('%s',$conversions->{'name'});
if (defined($conversions) && defined($conversions->{'Name'})) {
$newKey = sprintf('%s',$conversions->{'Name'});
}
$newStat->{$newKey} = $stat->{'counter'};
......@@ -1293,5 +1358,6 @@ sub _fixCounterName
}
1;
# vim: ts=4
opentrafficshaper/plugins/tc/tc.pm
View file @ efc9ebe1
# OpenTrafficShaper Linux tc traffic shaping
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -21,41 +21,52 @@ package opentrafficshaper::plugins::tc;
use strict;
use warnings;
use JSON;
use List::Util qw(min max);
use POE qw(
Wheel::Run Filter::Line
);
use POE qw( Wheel::Run Filter::Line );
use awitpt::util qw(
toHex
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use opentrafficshaper::plugins::configmanager qw(
getPool
getPoolAttribute
setPoolAttribute
removePoolAttribute
getPoolTxInterface
getPoolRxInterface
setPoolShaperState
unsetPoolShaperState
getPoolShaperState
getEffectivePool
getPoolMember
setPoolMemberAttribute
getPoolMemberAttribute
removePoolMemberAttribute
getPoolMemberMatchPriority
setPoolMemberShaperState
unsetPoolMemberShaperState
getPoolMemberShaperState
getTrafficClassPriority
getInterfaces
getInterfaceRate
getInterfaceTrafficClasses
getInterfaceDefaultPool
getPool
getPoolAttribute
setPoolAttribute
removePoolAttribute
getPoolTxInterface
getPoolRxInterface
setPoolShaperState
unsetPoolShaperState
getPoolShaperState
getEffectivePool
getPoolMember
setPoolMemberAttribute
getPoolMemberAttribute
removePoolMemberAttribute
getPoolMemberMatchPriority
setPoolMemberShaperState
unsetPoolMemberShaperState
getPoolMemberShaperState
getTrafficClassPriority
getAllTrafficClasses
getInterface
getInterfaceGroup
getInterfaceGroups
getInterfaces
getInterfaceDefaultPool
getEffectiveInterfaceTrafficClass2
isInterfaceTrafficClassValid
setInterfaceTrafficClassShaperState
unsetInterfaceTrafficClassShaperState
);
......@@ -69,7 +80,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.1.2',
VERSION => '1.0.1',
# 5% of a link can be used for very high priority traffic
PROTO_RATE_LIMIT => 5,
......@@ -95,8 +106,9 @@ our $pluginInfo = {
};
# Copy of system globals
# Our globals
my $globals;
# Copy of system logger
my $logger;
# Our configuration
......@@ -105,33 +117,42 @@ my $config = {
'iphdr_offset' => 0,
};
# Queue of tasks to run
my @taskQueue = ( );
# TC classes & filters
my $tcClasses = { };
my $tcFilterMappings;
my $tcFilters = { };
#
# TASK QUEUE
#
# $globals->{'TaskQueue'}
#
# TC CLASSES & FILTERS
#
# $globals->{'TcClasses'}
# $globals->{'TcFilterMappings'}
# $globals->{'TcFilters'}
# Initialize plugin
sub plugin_init
{
$globals = shift;
my $system = shift;
# Setup our environment
$logger = $globals->{'logger'};
$logger = $system->{'logger'};
$logger->log(LOG_NOTICE,"[TC] OpenTrafficShaper tc Integration v%s - Copyright (c) 2007-2014, AllWorldIT",VERSION);
$logger->log(LOG_NOTICE,"[TC] OpenTrafficShaper tc Integration v%s - Copyright (c) 2007-2023, AllWorldIT",VERSION);
# Initialize
$globals->{'TaskQueue'} = [ ];
$globals->{'TcClasses'} = { };
$globals->{'TcFilterMappings'} = { };
$globals->{'TcFilters'} = { };
# Grab some of our config we need
if (defined(my $proto = $globals->{'file.config'}->{'plugin.tc'}->{'protocol'})) {
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 = $globals->{'file.config'}->{'plugin.tc'}->{'iphdr_offset'})) {
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;
}
......@@ -139,11 +160,261 @@ sub plugin_init
# We going to queue the initialization in plugin initialization so nothing at all can come before us
my $changeSet = TC::ChangeSet->new();
# Loop with protocols
for my $ipv ("", "6") {
#
# Traffic Shaping
#
# First the Cleanup
#
foreach my $interfaceID (getInterfaces()) {
my $interface = getInterface($interfaceID);
# Flush inteface chain
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-F',"ots-tcfor-$interfaceID",
]);
# Delete jump
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-D','ots-tcfor',
'-o',$interface->{'Device'},
'-j',"ots-tcfor-$interfaceID",
]);
# Delete interface chain
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-X',"ots-tcfor-$interfaceID",
]);
}
# Flush ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-F','ots-tcfor',
]);
# Delete jump to ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-D','FORWARD',
'-j','ots-tcfor',
]);
# Delete ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-X','ots-tcfor',
]);
# Then the setup
#
# Create ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-N','ots-tcfor',
]);
# Add jump to ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-I','FORWARD',
'-j','ots-tcfor',
]);
# Add interface chains
foreach my $interfaceID (getInterfaces()) {
my $interface = getInterface($interfaceID);
# Create ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-N',"ots-tcfor-$interfaceID",
]);
# Add jump to ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-A','ots-tcfor',
'-o',$interface->{'Device'},
'-j',"ots-tcfor-$interfaceID",
]);
}
#
# NAT
#
# First the Cleanup
#
foreach my $interfaceGroupName (getInterfaceGroups()) {
my $interfaceGroup = getInterfaceGroup($interfaceGroupName);
my $txInterfaceID = $interfaceGroup->{'TxInterface'};
my $rxInterfaceID = $interfaceGroup->{'RxInterface'};
my $txInterface = getInterface($txInterfaceID);
my $rxInterface = getInterface($rxInterfaceID);
# Flush inteface chains
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-F',"ots-snat-$txInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-F',"ots-dnat-$rxInterfaceID",
]);
# Delete interface chains
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-X',"ots-snat-$txInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-X',"ots-dnat-$rxInterfaceID",
]);
}
# Flush ots-snat and ots-dnat
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-F','ots-snat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-F','ots-dnat',
]);
# Delete jump to ots-snat and ots-dnat
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-D','POSTROUTING',
'-j','ots-snat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-D','OUTPUT',
'-j','ots-dnat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-D','PREROUTING',
'-j','ots-dnat',
]);
# Delete ots-tcfor
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-X','ots-snat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-X','ots-dnat',
]);
# Then the setup
#
# Create ots-snat and ots-dnat
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-N','ots-snat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-N','ots-dnat',
]);
# Add jump to ots-snat and ots-dnat
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-I','POSTROUTING',
'-j','ots-snat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-I','OUTPUT',
'-j','ots-dnat',
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A','PREROUTING',
'-j','ots-dnat',
]);
foreach my $interfaceGroupName (getInterfaceGroups()) {
my $interfaceGroup = getInterfaceGroup($interfaceGroupName);
my $txInterfaceID = $interfaceGroup->{'TxInterface'};
my $rxInterfaceID = $interfaceGroup->{'RxInterface'};
my $txInterface = getInterface($txInterfaceID);
my $rxInterface = getInterface($rxInterfaceID);
# Flush inteface chain
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-N',"ots-snat-$txInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-N',"ots-dnat-$rxInterfaceID",
]);
# Add interface chains
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A','ots-snat',
'-o',$rxInterface->{'Device'},
'-j',"ots-snat-$txInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A','ots-snat',
'-o',$txInterface->{'Device'},
'-j',"ots-snat-$txInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A','ots-dnat',
'-i',$rxInterface->{'Device'},
'-j',"ots-dnat-$rxInterfaceID",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A','ots-dnat',
'-i',$txInterface->{'Device'},
'-j',"ots-dnat-$rxInterfaceID",
]);
}
}
# Loop with the configured interfaces and initialize them
foreach my $interface (@{getInterfaces()}) {
foreach my $interfaceID (getInterfaces()) {
my $interface = getInterface($interfaceID);
# Initialize interface
$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '%s'",$interface);
_tc_iface_init($changeSet,$interface);
$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '%s'",$interface->{'Device'});
_tc_iface_init($changeSet,$interfaceID);
}
_task_add_to_queue($changeSet);
......@@ -154,6 +425,8 @@ sub plugin_init
_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,
......@@ -189,6 +462,7 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
......@@ -196,6 +470,7 @@ sub plugin_start
}
# Initialize this plugins main POE session
sub _session_start
{
......@@ -209,6 +484,7 @@ sub _session_start
}
# Initialize this plugins main POE session
sub _session_stop
{
......@@ -220,9 +496,6 @@ sub _session_stop
# Blow away data
$globals = undef;
@taskQueue = ();
$tcFilterMappings = undef;
# XXX: Destroy the rest too like config
$logger->log(LOG_DEBUG,"[TC] Shutdown");
......@@ -230,6 +503,62 @@ sub _session_stop
}
# 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
{
......@@ -239,14 +568,14 @@ sub _session_pool_add
# Grab pool
my $pool;
if (!defined($pool = getPool($pid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'remove' event with non existing pool '%s'",$pid);
$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing pool '%s'",$pid);
return;
}
$logger->log(LOG_INFO,"[TC] Add pool '%s' to interface group '%s' [%s]",
$logger->log(LOG_INFO,"[TC] Add pool '%s' [%s] to interface group '%s'",
$pool->{'Name'},
$pool->{'ID'},
$pool->{'InterfaceGroupID'},
$pool->{'ID'}
);
# Grab our effective pool
......@@ -255,40 +584,40 @@ sub _session_pool_add
my $changeSet = TC::ChangeSet->new();
# Grab some things we need from the main pool
my $txInterface = getPoolTxInterface($pool->{'ID'});
my $rxInterface = getPoolRxInterface($pool->{'ID'});
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Grab effective config
my $classID = $effectivePool->{'ClassID'};
my $trafficLimitTx = $effectivePool->{'TrafficLimitTx'};
my $trafficLimitTxBurst = $effectivePool->{'TrafficLimitTxBurst'};
my $trafficLimitRx = $effectivePool->{'TrafficLimitRx'};
my $trafficLimitRxBurst = $effectivePool->{'TrafficLimitRxBurst'};
my $trafficPriority = getTrafficClassPriority($effectivePool->{'ClassID'});
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($txInterface,$classID);
my $tcClass_TxTrafficClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
# Generate our pools Tx TC class
my $tcClass_TxPool = _reserveTcClassByPoolID($txInterface,$pool->{'ID'});
my $tcClass_TxPool = _reserveMinorTcClassByPoolID($txInterfaceID,$pool->{'ID'});
# Add the main Tx TC class for this pool
_tc_class_add($changeSet,$txInterface,TC_ROOT_CLASS,$tcClass_TxTrafficClass,$tcClass_TxPool,$trafficLimitTx,
$trafficLimitTxBurst,$trafficPriority
_tc_class_add($changeSet,$txInterfaceID,TC_ROOT_CLASS,$tcClass_TxTrafficClass,$tcClass_TxPool,$txCIR,
$txLimit,$trafficPriority
);
# Add Tx TC optimizations
_tc_class_optimize($changeSet,$txInterface,$tcClass_TxPool,$trafficLimitTx);
_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($rxInterface,$classID);
my $tcClass_RxTrafficClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
# Generate our pools Rx TC class
my $tcClass_RxPool = _reserveTcClassByPoolID($rxInterface,$pool->{'ID'});
my $tcClass_RxPool = _reserveMinorTcClassByPoolID($rxInterfaceID,$pool->{'ID'});
# Add the main Rx TC class for this pool
_tc_class_add($changeSet,$rxInterface,TC_ROOT_CLASS,$tcClass_RxTrafficClass,$tcClass_RxPool,$trafficLimitRx,
$trafficLimitRxBurst,$trafficPriority
_tc_class_add($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$tcClass_RxTrafficClass,$tcClass_RxPool,$rxCIR,
$rxLimit,$trafficPriority
);
# Add Rx TC optimizations
_tc_class_optimize($changeSet,$rxInterface,$tcClass_RxPool,$trafficLimitRx);
_tc_class_optimize($changeSet,$rxInterfaceID,$tcClass_RxPool,$rxCIR);
# Set Rx TC
setPoolAttribute($pool->{'ID'},'tc.rxclass',$tcClass_RxPool);
......@@ -296,11 +625,11 @@ sub _session_pool_add
$kernel->post("_tc" => "queue" => $changeSet);
# Set current live values
setPoolAttribute($pool->{'ID'},'shaper.live.ClassID',$classID);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTx',$trafficLimitTx);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTxBurst',$trafficLimitTxBurst);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRx',$trafficLimitRx);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRxBurst',$trafficLimitRxBurst);
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);
......@@ -308,6 +637,7 @@ sub _session_pool_add
}
# Event handler for removing a pool
sub _session_pool_remove
{
......@@ -338,38 +668,41 @@ sub _session_pool_remove
);
# Grab our interfaces
my $txInterface = getPoolTxInterface($pool->{'ID'});
my $rxInterface = getPoolRxInterface($pool->{'ID'});
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 $classID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
my $trafficClassID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
# Grab our minor classes
my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterface,$classID);
my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterface,$classID);
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,
'dev',$txInterface->{'Device'},
'parent',"1:$txTrafficClassTcClass",
'classid',"1:$txPoolTcClass",
]);
$changeSet->add([
'/sbin/tc','class','del',
'dev',$rxInterface,
'dev',$rxInterface->{'Device'},
'parent',"1:$rxTrafficClassTcClass",
'classid',"1:$rxPoolTcClass",
]);
# And recycle the classs
_disposePoolTcClass($txInterface,$txPoolTcClass);
_disposePoolTcClass($rxInterface,$rxPoolTcClass);
_disposePoolTcClass($txInterface->{'Device'},$txPoolTcClass);
_disposePoolTcClass($rxInterface->{'Device'},$rxPoolTcClass);
_disposePrioTcClass($txInterface,$txPoolTcClass);
_disposePrioTcClass($rxInterface,$rxPoolTcClass);
_disposePrioTcClass($txInterface->{'Device'},$txPoolTcClass);
_disposePrioTcClass($rxInterface->{'Device'},$rxPoolTcClass);
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
......@@ -379,10 +712,10 @@ sub _session_pool_remove
removePoolAttribute($pool->{'ID'},'tc.rxclass');
removePoolAttribute($pool->{'ID'},'shaper.live.ClassID');
removePoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTx');
removePoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTxBurst');
removePoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRx');
removePoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRxBurst');
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);
......@@ -390,10 +723,11 @@ sub _session_pool_remove
}
## Event handler for changing a pool
sub _session_pool_change
{
my ($kernel, $pid) = @_[KERNEL, ARG0, ARG1];
my ($kernel, $pid) = @_[KERNEL, ARG0];
# Grab pool
......@@ -405,40 +739,40 @@ sub _session_pool_change
my $effectivePool = getEffectivePool($pool->{'ID'});
# Grab our interfaces
my $txInterface = getPoolTxInterface($pool->{'ID'});
my $rxInterface = getPoolRxInterface($pool->{'ID'});
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 $classID = $effectivePool->{'ClassID'};
my $trafficLimitTx = $effectivePool->{'TrafficLimitTx'};
my $trafficLimitTxBurst = $effectivePool->{'TrafficLimitTxBurst'};
my $trafficLimitRx = $effectivePool->{'TrafficLimitRx'};
my $trafficLimitRxBurst = $effectivePool->{'TrafficLimitRxBurst'};
my $trafficPriority = getTrafficClassPriority($classID);
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($txInterface,$classID);
my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterface,$classID);
my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
# Generate changeset
my $changeSet = TC::ChangeSet->new();
_tc_class_change($changeSet,$txInterface,TC_ROOT_CLASS,$txTrafficClassTcClass,$txPoolTcClass,$trafficLimitTx,
$trafficLimitTxBurst,$trafficPriority);
_tc_class_change($changeSet,$rxInterface,TC_ROOT_CLASS,$rxTrafficClassTcClass,$rxPoolTcClass,$trafficLimitRx,
$trafficLimitRxBurst,$trafficPriority);
_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',$classID);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTx',$trafficLimitTx);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitTxBurst',$trafficLimitTxBurst);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRx',$trafficLimitRx);
setPoolAttribute($pool->{'ID'},'shaper.live.TrafficLimitRxBurst',$trafficLimitRxBurst);
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);
......@@ -446,6 +780,7 @@ sub _session_pool_change
}
# Event handler for adding a pool member
sub _session_poolmember_add
{
......@@ -459,188 +794,102 @@ sub _session_poolmember_add
return;
}
$logger->log(LOG_INFO,"[TC] Add pool member '%s' to pool '%s' [%s]",
$poolMember->{'IPAddress'},
$poolMember->{'PoolID'},
$poolMember->{'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];
# 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;
}
# Grab some variables we going to need below
my $txInterface = getPoolTxInterface($pool->{'ID'});
my $rxInterface = getPoolRxInterface($pool->{'ID'});
my $trafficPriority = getTrafficClassPriority($pool->{'ClassID'});
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($tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1})) {
# Grab filter ID's for 2nd level
my $filterID = _reserveTcFilter($txInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$txInterface}->{'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,$txInterface,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},800,"",
"$ip1.0.0.0/8","00ff0000");
}
if (!defined($tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1})) {
# Grab filter ID's for 2nd level
my $filterID = _reserveTcFilter($rxInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$rxInterface}->{'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,$rxInterface,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($tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2})) {
# Grab filter ID's for 3rd level
my $filterID = _reserveTcFilter($txInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip1HtHex = $tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{'id'};
# And hex our IP component
my $ip2Hex = toHex($ip2);
$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,$txInterface,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip1HtHex,
$ip2Hex,"$ip1.$ip2.0.0/16","0000ff00");
}
if (!defined($tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2})) {
# Grab filter ID's for 3rd level
my $filterID = _reserveTcFilter($rxInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip1HtHex = $tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{'id'};
# And hex our IP component
my $ip2Hex = toHex($ip2);
$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,$rxInterface,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip1HtHex,
$ip2Hex,"$ip1.$ip2.0.0/16","0000ff00");
}
$logger->log(LOG_INFO,"[TC] Add pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) to pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'ID'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
# Check if we have our /24 hash entry, if not we must create the 4th level hash table
if (!defined($tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3})) {
# Grab filter ID's for 4th level
my $filterID = _reserveTcFilter($txInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip2HtHex = $tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'};
# And hex our IP component
my $ip3Hex = toHex($ip3);
$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,$txInterface,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip2HtHex,
$ip3Hex,"$ip1.$ip2.$ip3.0/24","000000ff");
}
if (!defined($tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3})) {
# Grab filter ID's for 4th level
my $filterID = _reserveTcFilter($rxInterface,$matchPriority,$pool->{'ID'});
# Track our mapping
$tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip2HtHex = $tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'};
# And hex our IP component
my $ip3Hex = toHex($ip3);
$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,$rxInterface,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip2HtHex,
$ip3Hex,"$ip1.$ip2.$ip3.0/24","000000ff");
}
my $changeSet = TC::ChangeSet->new();
#
# 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 = $tcFilterMappings->{$txInterface}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'};
# And hex our IP component
my $ip4Hex = toHex($ip4);
$logger->log(LOG_DEBUG,"[TC] Linking pool member IP '%s' to class '%s' at hash endpoint '%s:%s'",
$poolMember->{'IPAddress'},
$tcClass_trafficClass,
$ip3HtHex,
$ip4Hex
);
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Link filter to traffic flow (class)
_tc_filter_add_flowlink($changeSet,$txInterface,TC_ROOT_CLASS,$trafficPriority,$config->{'ip_protocol'},$ip3HtHex,$ip4Hex,
"dst",16,$poolMember->{'IPAddress'},$tcClass_trafficClass);
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
# Save pool member filter ID
setPoolMemberAttribute($poolMember->{'ID'},'tc.txfilter',"${ip3HtHex}:${ip4Hex}:1");
# Check what IP version we're dealing with
my $ipv = "";
if ($poolMember->{'IPAddress'} =~ /:/) {
$ipv = "6";
}
# 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 = $tcFilterMappings->{$rxInterface}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'};
# And hex our IP component
my $ip4Hex = toHex($ip4);
$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,$rxInterface,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");
# Add traffic classification
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-A',"ots-tcfor-$rxInterfaceID",
'-s',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','CLASSIFY',
'--set-class',"1:$rxPoolTcClass",
]);
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-A',"ots-tcfor-$txInterfaceID",
'-d',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','CLASSIFY',
'--set-class',"1:$txPoolTcClass",
]);
# Add NAT if we have any
if (defined($poolMember->{'IPNATAddress'}) && defined($poolMember->{'IPNATAddress'}) ne "") {
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A',"ots-snat-$txInterfaceID",
'-s',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','SNAT',
'--to-source', $poolMember->{'IPNATAddress'},
]);
# If we're dealing with IPv4, clear the connection tracking
if ($ipv eq "") {
$changeSet->add(["/sbin/conntrack",'-D','-s',$poolMember->{'IPAddress'}]);
}
if (defined($poolMember->{'IPNATInbound'}) && $poolMember->{'IPNATInbound'} eq "yes") {
my @ipComponents = split(/\//,$poolMember->{'IPAddress'});
my $dnatTo = $ipComponents[0];
if (@ipComponents < 2 || $ipComponents[1] eq "32" || $ipComponents[1] eq "128") {
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-A',"ots-dnat-$rxInterfaceID",
'-d',$poolMember->{'IPNATAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','DNAT',
'--to-destination', $dnatTo,
]);
} else {
$logger->log(LOG_WARN,"[TC] Cannot add inbound NAT for pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) to pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'ID'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
}
}
}
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
......@@ -650,6 +899,7 @@ sub _session_poolmember_add
}
# Event handler for removing a pool member
sub _session_poolmember_remove
{
......@@ -668,112 +918,167 @@ sub _session_poolmember_remove
# 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'",
$logger->log(LOG_WARN,"[TC] Ignoring remove for pool member '%s' with IP '%s', NAT '%s' (inbound: %s) [%s] from pool '%s'",
$poolMember->{'Username'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$poolMember->{'ID'},
$pool->{'Name'}
);
return;
}
$logger->log(LOG_INFO,"[TC] Removing pool member '%s' with IP '%s' [%s] from pool '%s'",
$logger->log(LOG_INFO,"[TC] Remove pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) from pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'IPAddress'},
$poolMember->{'ID'},
$pool->{'Name'}
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
# Grab our interfaces
my $txInterface = getPoolTxInterface($pool->{'ID'});
my $rxInterface = 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 $classID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
my $trafficPriority = getTrafficClassPriority($classID);
my $changeSet = TC::ChangeSet->new();
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
my $changeSet = TC::ChangeSet->new();
my $txInterface = getInterface($txInterfaceID);
my $rxInterface = getInterface($rxInterfaceID);
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
# Clear up the filter
# Check what IP version we're dealing with
my $ipv = "";
if ( $poolMember->{'IPAddress'} =~ /:/ ) {
$ipv = 6;
}
# Remove traffic classification
$changeSet->add([
'/sbin/tc','filter','del',
'dev',$txInterface,
'parent','1:',
'prio',$trafficPriority,
'handle',$txFilter,
'protocol',$config->{'ip_protocol'},
'u32',
"/sbin/ip${ipv}tables",
'-t','mangle',
'-D',"ots-tcfor-$rxInterfaceID",
'-s',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','CLASSIFY',
'--set-class',"1:$rxPoolTcClass",
]);
$changeSet->add([
'/sbin/tc','filter','del',
'dev',$rxInterface,
'parent','1:',
'prio',$trafficPriority,
'handle',$rxFilter,
'protocol',$config->{'ip_protocol'},
'u32',
"/sbin/ip${ipv}tables",
'-t','mangle',
'-D',"ots-tcfor-$txInterfaceID",
'-d',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','CLASSIFY',
'--set-class',"1:$txPoolTcClass",
]);
# Remove NAT if we have any
if (defined($poolMember->{'IPNATAddress'}) && defined($poolMember->{'IPNATAddress'}) ne "") {
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-D',"ots-snat-$txInterfaceID",
'-s',$poolMember->{'IPAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','SNAT',
'--to-source', $poolMember->{'IPNATAddress'},
]);
if (defined($poolMember->{'IPNATInbound'}) && $poolMember->{'IPNATInbound'} eq "yes") {
my @ipComponents = split(/\//,$poolMember->{'IPAddress'});
my $dnatTo = $ipComponents[0];
if (@ipComponents < 2 || $ipComponents[1] eq "32" || $ipComponents[1] eq "128") {
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','nat',
'-D',"ots-dnat-$rxInterfaceID",
'-d',$poolMember->{'IPNATAddress'},
'-m','comment',
'--comment', "pool: ".$pool->{'Name'}.", member: ".$poolMember->{'Username'},
'-j','DNAT',
'--to-destination', $dnatTo,
]);
} else {
$logger->log(LOG_WARN,"[TC] Cannot remove inbound NAT for pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) to pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'ID'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
}
}
}
# 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 ($interface,$majorTcClass,$minorTcClass) = @_;
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
# Return the pool ID if found
my $ref = __getRefByMinorTcClass($interface,$majorTcClass,$minorTcClass);
my $ref = __getRefByMinorTcClass($interfaceID,$majorTcClass,$minorTcClass);
if (!defined($ref) || substr($ref,0,13) ne "_pool_class_:") {
return undef;
return;
}
return substr($ref,13);
}
# Function to return if this is linked to a pool's class
sub isPoolTcClass
{
my ($interface,$majorTcClass,$minorTcClass) = @_;
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
my $pid = getPIDFromTcClass($interface,$majorTcClass,$minorTcClass);
my $pid = getPIDFromTcClass($interfaceID,$majorTcClass,$minorTcClass);
if (!defined($pid)) {
return undef;
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 ($interface,$majorTcClass,$minorTcClass) = @_;
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
# Grab ref
my $ref = __getRefByMinorTcClass($interface,$majorTcClass,$minorTcClass);
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 undef;
return;
}
# Else return the part after the above tag
......@@ -789,924 +1094,529 @@ sub getCIDFromTcClass
# Function to initialize an interface
sub _tc_iface_init
{
my ($changeSet,$interface) = @_;
my ($changeSet,$interfaceID) = @_;
# Grab our interface rate
my $rate = getInterfaceRate($interface);
# Grab interface class configuration
my $trafficClasses = getInterfaceTrafficClasses($interface);
my $interface = getInterface($interfaceID);
### --- Interface Setup
# Clear the qdisc from the interface
$changeSet->add([
'/sbin/tc','qdisc','del',
'dev',$interface,
'dev',$interface->{'Device'},
'root',
]);
# Initialize the major TC class
_reserveMajorTcClass($interface,"root");
my $interfaceTcClass = _reserveMajorTcClass($interfaceID,"root");
# Set interface RootClass
$globals->{'Interfaces'}->{$interfaceID} = {
'TcClass' => $interfaceTcClass
};
### --- Interface Traffic Class Setup
# Reserve our parent TC classes
foreach my $classID (sort {$a <=> $b} keys %{$trafficClasses}) {
# We don't really need the result, we just need the class created
_reserveTcClassByTrafficClassID($interface,$classID);
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($interface);
my $defaultPoolTcClass;
if (defined($defaultPool)) {
# Push unclassified traffic to this class
$defaultPoolTcClass = _getTcClassFromTrafficClassID($interface,$defaultPool);
push(@qdiscOpts,'default',$defaultPoolTcClass);
}
### --- Interface Setup Part 2
# Add root qdisc
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface,
'dev',$interface->{'Device'},
'root',
'handle','1:',
'htb',
@qdiscOpts
'htb'
]);
# Attach our main rate to the qdisc
# Attach our main limit on the qdisc
my $burst = int( ($interface->{'Limit'} / 8) * 1024 * 10); # Allow the entire interface to be emptied with a burst
$changeSet->add([
'/sbin/tc','class','add',
'dev',$interface,
'dev',$interface->{'Device'},
'parent','1:',
'classid','1:1',
'htb',
'rate',"${rate}kbit",
'burst',"${rate}kb",
'rate',"$interface->{'Limit'}kbit",
]);
# Setup the classes
while ((my $classID, my $class) = each(%{$trafficClasses})) {
my $tcClass = _getTcClassFromTrafficClassID($interface,$classID);
# Class 0 is our interface, it points to 1 (the major TcClass)) : 1 (class below)
$globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{'0'} = {
'TcClass' => '1',
'CIR' => $interface->{'Limit'},
'Limit' => $interface->{'Limit'}
};
my $trafficPriority = getTrafficClassPriority($classID);
### --- Setup each class
# Setup the classes
foreach my $trafficClassID (@trafficClasses) {
my $interfaceTrafficClassID = isInterfaceTrafficClassValid($interfaceID,$trafficClassID);
my $interfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClassID);
my $tcClass = _getTcClassFromTrafficClassID($interfaceID,$trafficClassID);
my $trafficPriority = getTrafficClassPriority($trafficClassID);
# Add class
$changeSet->add([
'/sbin/tc','class','add',
'dev',$interface,
'dev',$interface->{'Device'},
'parent','1:1',
'classid',"1:$tcClass",
'htb',
'rate',"$class->{'cir'}kbit",
'ceil',"$class->{'limit'}kbit",
'rate',"$interfaceTrafficClass->{'CIR'}kbit",
'ceil',"$interfaceTrafficClass->{'Limit'}kbit",
'prio',$trafficPriority,
'burst', "$class->{'limit'}kb",
]);
# Setup interface traffic class details
$globals->{'Interfaces'}->{$interfaceID}->{'TrafficClasses'}->{$trafficClassID} = {
'TcClass' => $tcClass,
'CIR' => $interfaceTrafficClass->{'CIR'},
'Limit' => $interfaceTrafficClass->{'Limit'}
};
}
# Process our default pool traffic optimizations
my $defaultPool = getInterfaceDefaultPool($interfaceID);
if (defined($defaultPool)) {
# If we have a rate for this iface, then use it
_tc_class_optimize($changeSet,$interface,$defaultPoolTcClass,$trafficClasses->{$defaultPool}->{'limit'});
# Make the queue size big enough
my $queueSize = ($rate * 1024) / 8;
# RED metrics (sort of as per manpage)
my $redAvPkt = 1000;
my $redMax = int($queueSize / 4); # 25% mark at 100% probabilty
my $redMin = int($redMax / 3); # Max/3 is when the probability starts
my $redBurst = int( ($redMin+$redMax) / (2*$redAvPkt));
my $redLimit = $queueSize;
my $prioTcClass = _getPrioTcClass($interface,$defaultPoolTcClass);
# Priority band
my $prioBand = 1;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface,
'parent',"$prioTcClass:".toHex($prioBand),
'handle',_reserveMajorTcClass($interface,"_default_pool_:$defaultPoolTcClass=>$prioBand").":",
'bfifo',
'limit',$queueSize,
]);
$prioBand++;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface,
'parent',"$prioTcClass:".toHex($prioBand),
'handle',_reserveMajorTcClass($interface,"_default_pool_:$defaultPoolTcClass=>$prioBand").":",
# TODO: NK - try enable the below
# 'estimator','1sec','4sec', # Quick monitoring, every 1s with 4s constraint
'red',
'min',$redMin,
'max',$redMax,
'limit',$redLimit,
'burst',$redBurst,
'avpkt',$redAvPkt,
# NK: ECN may cause excessive dips in traffic if there is an exceptional amount of traffic
# 'ecn'
# XXX: Very new kernels only ... use redflowlimit in future
# 'sfq',
# 'divisor','16384',
# 'headdrop',
# 'redflowlimit',$queueSize,
# 'ecn',
]);
my $interfaceTrafficClassID = isInterfaceTrafficClassValid($interfaceID,$defaultPool);
my $interfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClassID);
my $defaultPoolTcClass = _getTcClassFromTrafficClassID($interfaceID, $defaultPool);
# Loop with IP versions
for my $ipv ("", "6") {
$changeSet->add([
"/sbin/ip${ipv}tables",
'-t','mangle',
'-A',"ots-tcfor-$interfaceID",
'-m','comment',
'--comment', "Default",
'-j','CLASSIFY',
'--set-class',"1:$defaultPoolTcClass",
]);
}
$prioBand++;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface,
'parent',"$prioTcClass:".toHex($prioBand),
'handle',_reserveMajorTcClass($interface,"_default_pool_:$defaultPoolTcClass=>$prioBand").":",
'red',
'min',$redMin,
'max',$redMax,
'limit',$redLimit,
'burst',$redBurst,
'avpkt',$redAvPkt,
# NK: ECN may cause excessive dips in traffic if there is an exceptional amount of traffic
# 'ecn'
]);
# If we have a rate for this iface, then use it
_tc_class_optimize($changeSet,$interfaceID,$defaultPoolTcClass,$interfaceTrafficClass->{'Limit'});
}
}
# Function to apply traffic optimizations to a classes
# XXX: This probably needs working on
sub _tc_class_optimize
{
my ($changeSet,$interface,$poolTcClass,$rate) = @_;
my ($changeSet,$interfaceID,$poolTcClass,$rate) = @_;
# Rate for things like ICMP , ACK, SYN ... etc
my $rateBand1 = int($rate * (PROTO_RATE_LIMIT / 100));
$rateBand1 = PROTO_RATE_BURST_MIN if ($rateBand1 < PROTO_RATE_BURST_MIN);
my $rateBand1Burst = ($rateBand1 / 8) * PROTO_RATE_BURST_MAXM;
# Rate for things like VoIP/SSH/Telnet
my $rateBand2 = int($rate * (PRIO_RATE_LIMIT / 100));
$rateBand2 = PRIO_RATE_BURST_MIN if ($rateBand2 < PRIO_RATE_BURST_MIN);
my $rateBand2Burst = ($rateBand2 / 8) * PRIO_RATE_BURST_MAXM;
my $prioTcClass = _reserveMajorTcClassByPrioClass($interface,$poolTcClass);
my $interface = getInterface($interfaceID);
my $prioTcClass = _reserveMajorTcClassByPrioClass($interfaceID,$poolTcClass);
#
# DEFINE 3 PRIO BANDS
#
# Mbyte/s rate divided by average packet size to get packet limit, with a minimum of 127
my $sfqQueueLength = max(int((($rate / 8) * 1024) / 1000), 127);
# Flows is Mbit/s divided by 20, with minimum of 127
my $sfqFlows = max(int($rate / 1000 / 20) * 127, 127);
my $sfqRedFlowLimit = ($sfqQueueLength / 4) * 1500; # Take 25% of the queue length and packet size of 1500
# We then prioritize traffic into 3 bands based on TOS
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface,
'dev',$interface->{'Device'},
'parent',"1:$poolTcClass",
'handle',"$prioTcClass:",
'prio',
'bands','3',
'priomap','2','2','2','2','2','2','2','2','2','2','2','2','2','2','2','2',
'sfq',
'limit', $sfqQueueLength, # first work out byte rate, then divide by average packet size of 1000
'flows', $sfqFlows,
'headdrop',
'perturb', 10,
'redflowlimit', $sfqRedFlowLimit,
'perturb', 10,
]);
#
# CLASSIFICATIONS
#
# Prioritize ICMP up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x1','0xff', # ICMP
'at',9+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand1}kbit",'burst',"${rateBand1Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# Prioritize ACK up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u8','0x10','0xff', # ACK
'at',33+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand1}kbit",'burst',"${rateBand1Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# Prioritize SYN-ACK up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u8','0x12','0xff', # SYN-ACK
'at',33+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand1}kbit",'burst',"${rateBand1Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# Prioritize FIN up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u8','0x1','0xff', # FIN
'at',33+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand1}kbit",'burst',"${rateBand1Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# Prioritize RST up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u8','0x4','0xff', # RST
'at',33+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand1}kbit",'burst',"${rateBand1Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# DNS
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x0035','0xffff', # SPORT 53
'at',20+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x0035','0xffff', # DPORT 53
'at',22+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# VOIP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x13c4','0xffff', # SPORT 5060
'at',20+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x13c4','0xffff', # DPORT 5060
'at',22+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# SNMP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0xa1','0xffff', # SPORT 161
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0xa1','0xffff', # DPORT 161
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:1",
]);
# TODO: Make this customizable not hard coded?
# Mikrotik Management Port
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x2063','0xffff', # SPORT 8291
'at',20+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u16','0x2063','0xffff', # DPORT 8291
'at',22+$config->{'iphdr_offset'},
'police',
'rate',"${rateBand2}kbit",'burst',"${rateBand2Burst}k",'continue',
'flowid',"$prioTcClass:1",
]);
# SMTP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x19','0xffff', # SPORT 25
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x19','0xffff', # DPORT 25
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
# POP3
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x6e','0xffff', # SPORT 110
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x6e','0xffff', # DPORT 110
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
# IMAP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x8f','0xffff', # SPORT 143
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x8f','0xffff', # DPORT 143
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
# HTTP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x50','0xffff', # SPORT 80
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x50','0xffff', # DPORT 80
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
# HTTPS
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x1bb','0xffff', # SPORT 443
'at',20+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$prioTcClass:",
'prio','1',
'protocol',$config->{'ip_protocol'},
'u32',
'match','u8','0x6','0xff', # TCP
'at',9+$config->{'iphdr_offset'},
'match','u16','0x1bb','0xffff', # DPORT 443
'at',22+$config->{'iphdr_offset'},
'flowid',"$prioTcClass:2",
]);
}
# Function to easily add a hash table
sub _tc_filter_add_dstlink
{
my ($changeSet,$interface,$parentID,$priority,$filterID,$protocol,$htHex,$ipHex,$cidr,$mask) = @_;
# Add hash table
_tc_filter_hash_add($changeSet,$interface,$parentID,$priority,$filterID,$config->{'ip_protocol'});
# Add filter to it
_tc_filter_add($changeSet,$interface,$parentID,$priority,$filterID,$protocol,$htHex,$ipHex,"dst",16,$cidr,$mask);
}
# Function to easily add a hash table
sub _tc_filter_add_srclink
# Function to add a TC class
sub _tc_class_add
{
my ($changeSet,$interface,$parentID,$priority,$filterID,$protocol,$htHex,$ipHex,$cidr,$mask) = @_;
my ($changeSet,$interfaceID,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
# Add hash table
_tc_filter_hash_add($changeSet,$interface,$parentID,$priority,$filterID,$config->{'ip_protocol'});
# Add filter to it
_tc_filter_add($changeSet,$interface,$parentID,$priority,$filterID,$protocol,$htHex,$ipHex,"src",12,$cidr,$mask);
}
my $interface = getInterface($interfaceID);
# # Set burst to a sane value, in this case the CIR (or $rate) size
# my $burst = int($rate / 8);
# my $cburst = int(($ceil - $rate) / 8 / 10);
# # NK: cburst should not exceed burst, if it does, just use the burst value
# # this ensures we do not get negative burst
# if ($cburst > $burst) {
# $cburst = $burst;
# }
my $burst = int( ($ceil / 8) * 1024 * 10);
my $cburst = int($rate / 8 / 5) + 2; # +2kb to cover 1600
my $quantum = int($cburst / 2) * 1024; # Burst in bytes
# Function to easily add a hash table
sub _tc_filter_add_flowlink
{
my ($changeSet,$interface,$parentID,$priority,$protocol,$htHex,$ipHex,$type,$offset,$ip,$poolTcClass) = @_;
# Link hash table
# Create main rate limiting classes
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$parentID:",
'prio',$priority,
'handle',"$htHex:$ipHex:1",
'protocol',$protocol,
'u32',
# Root hash table
'ht',"$htHex:$ipHex:",
'match','ip',$type,$ip,
'at',$offset+$config->{'iphdr_offset'},
# Link to our flow
'flowid',"1:$poolTcClass",
'/sbin/tc','class','add',
'dev',$interface->{'Device'},
'parent',"$majorTcClass:$trafficClassTcClass",
'classid',"$majorTcClass:$poolTcClass",
'htb',
'rate', "${rate}kbit",
'ceil', "${ceil}kbit",
# 'prio', $trafficPriority,
# 'burst', "${burst}kb",
# 'cburst', "${cburst}kb",
]);
}
# Function to easily add a hash table
sub _tc_filter_hash_add
{
my ($changeSet,$interface,$parentID,$priority,$filterID,$protocol) = @_;
# Function to change a TC class
sub _tc_class_change
{
my ($changeSet,$interfaceID,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
# Create second level hash table for $ip1
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$parentID:",
'prio',$priority,
'handle',"$filterID:",
'protocol',$protocol,
'u32',
'divisor','256',
]);
}
my $interface = getInterface($interfaceID);
# Function to easily add a hash table
sub _tc_filter_add
{
my ($changeSet,$interface,$parentID,$priority,$filterID,$protocol,$htHex,$ipHex,$type,$offset,$cidr,$mask) = @_;
my @args = ();
# If ceil is not available, set it to the CIR (or $rate in this case)
if (!defined($ceil)) {
$ceil = $rate;
}
# Link hash table
# # Set the burst rate to the CIR (or $rate in this case)
# my $burst = int($rate / 8);
# my $cburst = int(($ceil - $rate) / 8 / 10);
# # NK: cburst should not exceed burst, if it does, just use the burst value
# # this ensures we do not get negative burst
# if ($cburst > $burst) {
# $cburst = $burst;
# }
my $burst = int( ($ceil / 8) * 1024 * 10);
my $cburst = int($rate / 8 / 5) + 2; # +2kb to cover 1600
my $quantum = int($cburst / 2) * 1024; # Burst in bytes
# # Check if we have a priority
# if (defined($trafficPriority)) {
# push(@args,'prio',$trafficPriority);
# }
# Create main rate limiting classes
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$interface,
'parent',"$parentID:",
'prio',$priority,
'protocol',$protocol,
'u32',
# Root hash table
'ht',"$htHex:$ipHex:",
'match','ip',$type,$cidr,
'at',$offset+$config->{'iphdr_offset'},
'hashkey','mask',"0x$mask",
'at',$offset+$config->{'iphdr_offset'},
# Link to our hash table
'link',"$filterID:"
'/sbin/tc','class','change',
'dev',$interface->{'Device'},
'parent',"$majorTcClass:$trafficClassTcClass",
'classid',"$majorTcClass:$poolTcClass",
'htb',
'rate', "${rate}kbit",
'ceil', "${ceil}kbit",
# 'burst', "${burst}kb",
# 'cburst', "${cburst}kb",
@args
]);
}
# Function to add a TC class
sub _tc_class_add
{
my ($changeSet,$interface,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
# Set burst to a sane value
my $burst = int($ceil / 8 / 5);
# Create main rate limiting classes
$changeSet->add([
'/sbin/tc','class','add',
'dev',$interface,
'parent',"$majorTcClass:$trafficClassTcClass",
'classid',"$majorTcClass:$poolTcClass",
'htb',
'rate', "${rate}kbit",
'ceil', "${ceil}kbit",
'prio', $trafficPriority,
'burst', "${burst}kb",
]);
}
# Function to change a TC class
sub _tc_class_change
{
my ($changeSet,$interface,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
# Set burst to a sane value
my $burst = int($ceil / 8 / 5);
# Create main rate limiting classes
$changeSet->add([
'/sbin/tc','class','change',
'dev',$interface,
'parent',"$majorTcClass:$trafficClassTcClass",
'classid',"$majorTcClass:$poolTcClass",
'htb',
'rate', "${rate}kbit",
'ceil', "${ceil}kbit",
'prio', $trafficPriority,
'burst', "${burst}kb",
]);
}
# Get a pool TC class from pool ID
sub _reserveTcClassByPoolID
sub _reserveMinorTcClassByPoolID
{
my ($interface,$pid) = @_;
my ($interfaceID,$pid) = @_;
return __reserveMinorTcClass($interface,TC_ROOT_CLASS,"_pool_class_:$pid");
return __reserveMinorTcClass($interfaceID,TC_ROOT_CLASS,"_pool_class_:$pid");
}
# Get a traffic class TC class
sub _reserveTcClassByTrafficClassID
sub _reserveMinorTcClassByTrafficClassID
{
my ($interface,$classID) = @_;
my ($interfaceID,$trafficClassID) = @_;
return __reserveMinorTcClass($interface,TC_ROOT_CLASS,"_traffic_class_:$classID");
return __reserveMinorTcClass($interfaceID,TC_ROOT_CLASS,"_traffic_class_:$trafficClassID");
}
# Get a prio class TC class
# This is a MAJOR class!
sub _reserveMajorTcClassByPrioClass
{
my ($interface,$classID) = @_;
my ($interfaceID,$trafficClassID) = @_;
return _reserveMajorTcClass($interface,"_priority_class_:$classID");
return _reserveMajorTcClass($interfaceID,"_priority_class_:$trafficClassID");
}
# Return TC class from a traffic class ID
sub _getTcClassFromTrafficClassID
{
my ($interface,$classID) = @_;
my ($interfaceID,$trafficClassID) = @_;
return __getMinorTcClassByRef($interface,TC_ROOT_CLASS,"_traffic_class_:$classID");
return __getMinorTcClassByRef($interfaceID,TC_ROOT_CLASS,"_traffic_class_:$trafficClassID");
}
# Return prio TC class using class
# This returns a MAJOR class from a tc class
sub _getPrioTcClass
{
my ($interface,$tcClass) = @_;
my ($interfaceID,$tcClass) = @_;
return __getMajorTcClassByRef($interface,"_priority_class_:$tcClass");
return __getMajorTcClassByRef($interfaceID,"_priority_class_:$tcClass");
}
# Function to dispose of a TC class
sub _disposePoolTcClass
{
my ($interface,$tcClass) = @_;
my ($interfaceID,$tcClass) = @_;
return __disposeMinorTcClass($interface,TC_ROOT_CLASS,$tcClass);
return __disposeMinorTcClass($interfaceID,TC_ROOT_CLASS,$tcClass);
}
# Function to dispose of a major TC class
# Uses a TC class to get a MAJOR class, then disposes it
sub _disposePrioTcClass
{
my ($interface,$tcClass) = @_;
my ($interfaceID,$tcClass) = @_;
# If we can grab the major class dipose of it
my $majorTcClass = _getPrioTcClass($interface,$tcClass);
my $majorTcClass = _getPrioTcClass($interfaceID,$tcClass);
if (!defined($majorTcClass)) {
return undef;
return;
}
return __disposeMajorTcClass($interface,$majorTcClass);
return __disposeMajorTcClass($interfaceID,$majorTcClass);
}
# Function to get next available TC class
sub __reserveMinorTcClass
{
my ($interface,$majorTcClass,$ref) = @_;
my ($interfaceID,$majorTcClass,$ref) = @_;
# Setup defaults if we don't have anything defined
if (!defined($tcClasses->{$interface}) || !defined($tcClasses->{$interface}->{$majorTcClass})) {
$tcClasses->{$interface}->{$majorTcClass} = {
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass} = {
# Skip 0 and 1
'counter' => 2,
'free' => [ ],
'track' => { },
'reverse' => { },
'Counter' => 2,
'Free' => [ ],
'Track' => { },
'Reverse' => { },
};
}
# Maybe we have one free?
my $minorTcClass = shift(@{$tcClasses->{$interface}->{$majorTcClass}->{'free'}});
my $minorTcClass = shift(@{$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Free'}});
# Generate new number
if (!$minorTcClass) {
$minorTcClass = $tcClasses->{$interface}->{$majorTcClass}->{'counter'}++;
$minorTcClass = $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Counter'}++;
# Hex it
$minorTcClass = toHex($minorTcClass);
}
$tcClasses->{$interface}->{$majorTcClass}->{'track'}->{$minorTcClass} = $ref;
$tcClasses->{$interface}->{$majorTcClass}->{'reverse'}->{$ref} = $minorTcClass;
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$minorTcClass} = $ref;
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref} = $minorTcClass;
return $minorTcClass;
}
# Function to get next available major TC class
sub _reserveMajorTcClass
{
my ($interface,$ref) = @_;
my ($interfaceID,$ref) = @_;
# Setup defaults if we don't have anything defined
if (!defined($tcClasses->{$interface})) {
$tcClasses->{$interface} = {
if (!defined($globals->{'TcClasses'}->{$interfaceID})) {
$globals->{'TcClasses'}->{$interfaceID} = {
# Skip 0
'counter' => 1,
'free' => [ ],
'track' => { },
'reverse' => { },
'Counter' => 1,
'Free' => [ ],
'Track' => { },
'Reverse' => { },
};
}
# Maybe we have one free?
my $majorTcClass = shift(@{$tcClasses->{$interface}->{'free'}});
my $majorTcClass = shift(@{$globals->{'TcClasses'}->{$interfaceID}->{'Free'}});
# Generate new number
if (!$majorTcClass) {
$majorTcClass = $tcClasses->{$interface}->{'counter'}++;
$majorTcClass = $globals->{'TcClasses'}->{$interfaceID}->{'Counter'}++;
# Hex it
$majorTcClass = toHex($majorTcClass);
}
$tcClasses->{$interface}->{'track'}->{$majorTcClass} = $ref;
$tcClasses->{$interface}->{'reverse'}->{$ref} = $majorTcClass;
$globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$majorTcClass} = $ref;
$globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref} = $majorTcClass;
return $majorTcClass;
}
# Get a minor class by its rerf
sub __getMinorTcClassByRef
{
my ($interface,$majorTcClass,$ref) = @_;
my ($interfaceID,$majorTcClass,$ref) = @_;
if (!defined($tcClasses->{$interface}) || !defined($tcClasses->{$interface}->{$majorTcClass})) {
return undef;
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
return;
}
return $tcClasses->{$interface}->{$majorTcClass}->{'reverse'}->{$ref};
return $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref};
}
# Get a major class by its rerf
sub __getMajorTcClassByRef
{
my ($interface,$ref) = @_;
my ($interfaceID,$ref) = @_;
if (!defined($tcClasses->{$interface})) {
return undef;
if (!defined($globals->{'TcClasses'}->{$interfaceID})) {
return;
}
return $tcClasses->{$interface}->{'reverse'}->{$ref};
return $globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref};
}
# Get ref using the minor tc class
sub __getRefByMinorTcClass
{
my ($interface,$majorTcClass,$minorTcClass) = @_;
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
if (!defined($tcClasses->{$interface}) || !defined($tcClasses->{$interface}->{$majorTcClass})) {
return undef;
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
return;
}
return $tcClasses->{$interface}->{$majorTcClass}->{'track'}->{$minorTcClass};
return $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$minorTcClass};
}
# Function to dispose of a TC class
sub __disposeMinorTcClass
{
my ($interface,$majorTcClass,$tcMinorClass) = @_;
my ($interfaceID,$majorTcClass,$tcMinorClass) = @_;
my $ref = $tcClasses->{$interface}->{$majorTcClass}->{'track'}->{$tcMinorClass};
my $ref = $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$tcMinorClass};
# Push onto free list
push(@{$tcClasses->{$interface}->{$majorTcClass}->{'free'}},$tcMinorClass);
push(@{$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Free'}},$tcMinorClass);
# Blank the value
$tcClasses->{$interface}->{$majorTcClass}->{'track'}->{$tcMinorClass} = undef;
delete($tcClasses->{$interface}->{$majorTcClass}->{'reverse'}->{$ref});
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$tcMinorClass} = undef;
delete($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref});
}
# Function to dispose of a major TC class
sub __disposeMajorTcClass
{
my ($interface,$tcMajorClass) = @_;
my ($interfaceID,$tcMajorClass) = @_;
my $ref = $tcClasses->{$interface}->{'track'}->{$tcMajorClass};
my $ref = $globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$tcMajorClass};
# Push onto free list
push(@{$tcClasses->{$interface}->{'free'}},$tcMajorClass);
push(@{$globals->{'TcClasses'}->{$interfaceID}->{'Free'}},$tcMajorClass);
# Blank the value
$tcClasses->{$interface}->{'track'}->{$tcMajorClass} = undef;
delete($tcClasses->{$interface}->{'reverse'}->{$ref});
$globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$tcMajorClass} = undef;
delete($globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref});
}
# Function to get next available TC filter
sub _reserveTcFilter
{
my ($interface,$ref) = @_;
my ($interfaceID,$ref) = @_;
# Setup defaults if we don't have anything defined
if (!defined($tcFilters->{$interface})) {
$tcFilters->{$interface} = {
if (!defined($globals->{'TcFilters'}->{$interfaceID})) {
$globals->{'TcFilters'}->{$interfaceID} = {
# Skip 0 and 1
'counter' => 2,
'free' => [ ],
'track' => { },
'Counter' => 2,
'Free' => [ ],
'Track' => { },
};
}
# Maybe we have one free?
my $filterID = shift(@{$tcFilters->{$interface}->{'free'}});
my $filterID = shift(@{$globals->{'TcFilters'}->{$interfaceID}->{'Free'}});
# Generate new number
if (!$filterID) {
$filterID = $tcFilters->{$interface}->{'counter'}++;
$filterID = $globals->{'TcFilters'}->{$interfaceID}->{'Counter'}++;
# We cannot use ID 800, its internal
$filterID = $tcFilters->{$interface}->{'counter'}++ if ($filterID == 800);
$filterID = $globals->{'TcFilters'}->{$interfaceID}->{'Counter'}++ if ($filterID == 800);
# Hex it
$filterID = toHex($filterID);
}
$tcFilters->{$interface}->{'track'}->{$filterID} = $ref;
$globals->{'TcFilters'}->{$interfaceID}->{'Track'}->{$filterID} = $ref;
return $filterID;
}
# Function to dispose of a TC Filter
sub _disposeTcFilter
{
my ($interface,$filterID) = @_;
my ($interfaceID,$filterID) = @_;
# Push onto free list
push(@{$tcFilters->{$interface}->{'free'}},$filterID);
push(@{$globals->{'TcFilters'}->{$interfaceID}->{'Free'}},$filterID);
# Blank the value
$tcFilters->{$interface}->{'track'}->{$filterID} = undef;
$globals->{'TcFilters'}->{$interfaceID}->{'Track'}->{$filterID} = undef;
}
#
# Task/child communication & handling stuff
#
# Initialize our tc session
sub _task_session_start
{
......@@ -1723,6 +1633,7 @@ sub _task_session_start
}
# Add task to queue
sub _task_add_to_queue
{
......@@ -1732,11 +1643,7 @@ sub _task_add_to_queue
# Extract the changeset into commands
my $numChanges = 0;
foreach my $cmd ($changeSet->extract()) {
# Rip off path to tc command
shift(@{$cmd});
# Build commandline string
my $cmdStr = join(' ',@{$cmd});
push(@taskQueue,$cmdStr);
push(@{$globals->{'TaskQueue'}},$cmd);
$numChanges++;
}
......@@ -1744,27 +1651,6 @@ sub _task_add_to_queue
}
# Send the next command in the task direction
sub _task_put_next
{
my ($heap,$task) = @_;
# Task was busy, this signifies its done, so lets take the next command
if (my $cmdStr = shift(@taskQueue)) {
# Remove off idle task list if its there
delete($heap->{'idle_tasks'}->{$task->ID});
$task->put($cmdStr);
$logger->log(LOG_DEBUG,"[TC] TASK/%s: Starting '%s' as %s with PID %s",$task->ID,$cmdStr,$task->ID,$task->PID);
# If there is no commands in the queue, set it to idle
} else {
# Set task to idle
$heap->{'idle_tasks'}->{$task->ID} = $task;
}
}
# Queue a task
sub _task_queue
......@@ -1776,63 +1662,57 @@ sub _task_queue
_task_add_to_queue($changeSet);
# Trigger a run if list is not empty
if (@taskQueue) {
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Run next task
sub _task_run_next
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# If we already have children processing tasks, don't create another
if (keys %{$heap->{'task_by_wid'}}) {
# Loop with idle tasks ... return if we found one
foreach my $task_id (keys %{$heap->{'idle_tasks'}}) {
_task_put_next($heap,$heap->{'idle_tasks'}->{$task_id});
# XXX: Limit concurrency to 1
last;
}
# XXX: Limit concurrency to 1
# NK: Limit concurrency to 1
return;
}
# Check if we have a task coming off the top of the task queue
if (@taskQueue) {
if (my $cmd = shift(@{$globals->{'TaskQueue'}})) {
my $cmdStr = encode_json($cmd);
# Create task
my $task = POE::Wheel::Run->new(
Program => [ '/sbin/tc', '-force', '-batch' ],
Conduit => 'pipe',
StdioFilter => POE::Filter::Line->new( Literal => "\n" ),
Program => $cmd,
StdoutFilter => POE::Filter::Line->new( Literal => "\n" ),
StderrFilter => POE::Filter::Line->new( Literal => "\n" ),
StdoutEvent => '_task_child_stdout',
StderrEvent => '_task_child_stderr',
CloseEvent => '_task_child_close',
StdinEvent => '_task_child_stdin',
ErrorEvent => '_task_child_error',
) or $logger->log(LOG_ERR,"[TC] TASK: Unable to start task");
# ErrorEvent => '_task_child_error',
) or $logger->log(LOG_ERR,"[TC] TASK: Unable to start task: $cmdStr");
# Set task ID
my $task_id = $task->ID;
# Intercept SIGCHLD
$kernel->sig_child($task->PID, "_SIGCHLD");
# Wheel events include the wheel's ID.
$heap->{'task_by_wid'}->{$task_id} = $task;
# Signal events include the process ID.
$heap->{'task_by_pid'}->{$task_id} = $task;
$heap->{'task_by_pid'}->{$task->PID} = $task;
_task_put_next($heap,$task);
# Build commandline string
$logger->log( LOG_DEBUG, "[TC] TASK/%s: Starting '%s' as %s with PID %s", $task->ID, $cmdStr, $task->ID, $task->PID );
}
}
# Child writes to STDOUT
sub _task_child_stdout
{
......@@ -1845,6 +1725,7 @@ sub _task_child_stdout
}
# Child writes to STDERR
sub _task_child_stderr
{
......@@ -1853,21 +1734,7 @@ sub _task_child_stderr
my $task = $heap->{'task_by_wid'}->{$task_id};
$logger->log(LOG_WARN,"[TC] TASK/%s: STDOUT => %s",$task_id,$stdout);
}
# Child flushed to STDIN
sub _task_child_stdin
{
my ($kernel,$heap,$task_id) = @_[KERNEL,HEAP,ARG0];
my $task = $heap->{'task_by_wid'}->{$task_id};
$logger->log(LOG_DEBUG,"[TC] TASK/%s is READY",$task_id);
# And shove another queued command its direction
_task_put_next($heap,$task);
$logger->log(LOG_WARN,"[TC] TASK/%s: STDERR => %s",$task_id,$stdout);
}
......@@ -1891,15 +1758,15 @@ sub _task_child_close
# Remove other references
delete($heap->{'task_by_wid'}->{$task_id});
delete($heap->{'task_by_pid'}->{$task->PID});
delete($heap->{'idle_tasks'}->{$task_id});
# Start next one, if there is a next one
if (@taskQueue) {
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Child got an error event, lets remove it too
sub _task_child_error
{
......@@ -1920,15 +1787,15 @@ sub _task_child_error
# Remove other references
delete($heap->{'task_by_wid'}->{$task_id});
delete($heap->{'task_by_pid'}->{$task->PID});
delete($heap->{'idle_tasks'}->{$task_id});
# Start next one, if there is a next one
if (@taskQueue) {
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Reap the dead child
sub _task_SIGCHLD
{
......@@ -1945,10 +1812,10 @@ sub _task_SIGCHLD
# Remove other references
delete($heap->{'task_by_wid'}->{$task->ID});
delete($heap->{'task_by_pid'}->{$pid});
delete($heap->{'idle_tasks'}->{$task->ID});
}
# Handle SIGINT
sub _task_SIGINT
{
......@@ -1988,6 +1855,7 @@ sub new
}
# Add a change to the list
sub add
{
......@@ -1997,6 +1865,7 @@ sub add
}
# Return the list
sub extract
{
......@@ -2007,5 +1876,20 @@ sub extract
# Return the list
sub debug
{
my $self = shift;
my @debug = ();
foreach my $item ($self->extract) {
push(@debug,join(' ',@{$item}));
}
return @debug;
}
1;
# vim: ts=4
opentrafficshaper/plugins/tcstats/tcstats.pm
View file @ efc9ebe1
# OpenTrafficShaper Linux tcstats traffic shaping statistics
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -24,13 +24,13 @@ use warnings;
use POE qw( Wheel::Run Filter::Line );
use POE::Filter::TCStatistics;
use opentrafficshaper::POE::Filter::TCStatistics;
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use opentrafficshaper::plugins::configmanager qw(
getInterface
getInterfaces
);
......@@ -45,9 +45,9 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.1.2',
VERSION => '1.0.0',
# How often our config check ticks
# How often we tick
TICK_PERIOD => 5,
};
......@@ -64,28 +64,34 @@ our $pluginInfo = {
};
# Copy of system globals
# Our globals
my $globals;
# Copy of system logger
my $logger;
# Last stats pulls
my $lastStats = { };
#
# $globals->{'LastStats'}
# Initialize plugin
sub plugin_init
{
$globals = shift;
my $system = shift;
# Setup our environment
$logger = $globals->{'logger'};
$logger = $system->{'logger'};
$logger->log(LOG_NOTICE,"[TCSTATS] OpenTrafficShaper tc Statistics Integration v%s - Copyright (c) 2013-2014, AllWorldIT",
VERSION
);
# Initialize
$globals->{'LastStats'} = { };
# This session is our main session, its alias is "shaper"
POE::Session->create(
inline_states => {
......@@ -106,13 +112,25 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
my @interfaces = getInterfaces();
my $now = time();
# Initialize last stats
foreach my $interfaceID (@interfaces) {
$globals->{'LastStats'}->{$interfaceID} = $now;
}
$logger->log(LOG_INFO,"[TCSTATS] Started");
}
# Initialize this plugins main POE session
sub _session_start
{
......@@ -129,6 +147,7 @@ sub _session_start
}
# Shut down session
sub _session_stop
{
......@@ -145,6 +164,7 @@ sub _session_stop
}
# Time ticker for processing changes
sub _session_tick
{
......@@ -154,27 +174,26 @@ sub _session_tick
# Now
my $now = time();
# Loop with interfaces that need stats
my $interfaceCount = 0;
foreach my $interface (@{getInterfaces()}) {
# Get sorted list of interfaces
my @interfaces = sort { $globals->{'LastStats'}->{$a} <=> $globals->{'LastStats'}->{$b} } getInterfaces();
# Skip to next if we've already run for this interface
if (defined($lastStats->{$interface}) &&
$lastStats->{$interface} + opentrafficshaper::plugins::statistics::STATISTICS_PERIOD > $now
) {
next;
}
# Grab the first interface in the list to process
my $interfaceID = shift(@interfaces);
# Check if its old enough to process stats for
if ($now - $globals->{'LastStats'}->{$interfaceID} > opentrafficshaper::plugins::statistics::STATISTICS_PERIOD) {
my $interface = getInterface($interfaceID);
$logger->log(LOG_INFO,"[TCSTATS] Generating stats for '%s'",$interface);
$logger->log(LOG_INFO,"[TCSTATS] Generating stats for '%s'",$interfaceID);
# TC commands to run
my $cmd = [ '/sbin/tc', '-s', 'class', 'show', 'dev', $interface, 'parent', '1:' ];
my $cmd = [ '/sbin/tc', '-j', '-s', 'class', 'show', 'dev', $interface->{'Device'}, 'parent', '1:' ];
# Create task
my $task = POE::Wheel::Run->new(
Program => $cmd,
StdinFilter => POE::Filter::Line->new(),
StdoutFilter => POE::Filter::TCStatistics->new(),
StdoutFilter => opentrafficshaper::POE::Filter::TCStatistics->new(),
StderrFilter => POE::Filter::Line->new(),
StdoutEvent => '_task_child_stdout',
StderrEvent => '_task_child_stderr',
......@@ -190,9 +209,9 @@ sub _session_tick
$heap->{task_by_pid}->{$task->PID} = $task;
# Signal events include the process ID.
$heap->{task_data}->{$task->ID} = {
'timestamp' => $now,
'interface' => $interface,
'current_stat' => { }
'Timestamp' => $now,
'Interface' => $interfaceID,
'CurrentStat' => { }
};
# Build commandline string
......@@ -200,20 +219,32 @@ sub _session_tick
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/%s: Starting '%s' as %s with PID %s",$task->ID,$cmdStr,$task->ID,$task->PID);
# Set last time we were run to now
$lastStats->{$interface} = $now;
$globals->{'LastStats'}->{$interfaceID} = $now;
# NK: Space the stats out, this will cause TICK_PERIOD to elapse before we do another interface
$interfaceCount++;
last;
# Grab next one for below calcs...
$interfaceID = shift(@interfaces);
}
# If we didn't fire up any stats, re-tick
if (!$interfaceCount) {
$kernel->delay('_tick' => TICK_PERIOD);
# Set default tick period
my $tickPeriod = opentrafficshaper::plugins::statistics::STATISTICS_PERIOD;
# Calculate optimal wait time
if (defined($interfaceID)) {
$tickPeriod = opentrafficshaper::plugins::statistics::STATISTICS_PERIOD - ($now - $globals->{'LastStats'}->{$interfaceID});
}
# Make sure wait time is not too long
if ($tickPeriod > opentrafficshaper::plugins::statistics::STATISTICS_PERIOD) {
$tickPeriod = opentrafficshaper::plugins::statistics::STATISTICS_PERIOD;
}
# Make sure wait time is not too short
if ($tickPeriod < opentrafficshaper::plugins::statistics::STATISTICS_PERIOD) {
$tickPeriod = opentrafficshaper::plugins::statistics::STATISTICS_PERIOD;
}
$kernel->delay('_tick' => $tickPeriod);
};
# Child writes to STDOUT
sub _task_child_stdout
{
......@@ -225,8 +256,8 @@ sub _task_child_stdout
# Grab task data
my $taskData = $heap->{'task_data'}->{$task_id};
my $interface = $taskData->{'interface'};
my $timestamp = $taskData->{'timestamp'};
my $interface = $taskData->{'Interface'};
my $timestamp = $taskData->{'Timestamp'};
# Stats ID to update
my $sid;
......@@ -234,18 +265,18 @@ sub _task_child_stdout
my $direction = opentrafficshaper::plugins::statistics::STATISTICS_DIR_TX;
# Is this a system class?
my $classChildDec = hex($stat->{'_class_child'});
my $classChildDec = hex($stat->{'TCClassChild'});
# Check if this is a limit class...
if (opentrafficshaper::plugins::tc::isPoolTcClass($interface,$stat->{'_class_parent'},$stat->{'_class_child'})) {
if (opentrafficshaper::plugins::tc::isPoolTcClass($interface,$stat->{'TCClassParent'},$stat->{'TCClassChild'})) {
if (defined(my $pid = opentrafficshaper::plugins::tc::getPIDFromTcClass($interface,$stat->{'_class_parent'},
$stat->{'_class_child'}))
if (defined(my $pid = opentrafficshaper::plugins::tc::getPIDFromTcClass($interface,$stat->{'TCClassParent'},
$stat->{'TCClassChild'}))
) {
$sid = opentrafficshaper::plugins::statistics::setSIDFromPID($pid);
$direction = opentrafficshaper::plugins::statistics::getTrafficDirection($pid,$interface);
} else {
$logger->log(LOG_WARN,"[TCSTATS] Pool traffic class '%s:%s' NOT FOUND",$stat->{'_class_parent'},
$stat->{'_class_child'}
$logger->log(LOG_WARN,"[TCSTATS] Pool traffic class '%s:%s' NOT FOUND",$stat->{'TCClassParent'},
$stat->{'TCClassChild'}
);
}
......@@ -259,12 +290,12 @@ sub _task_child_stdout
} else {
# Save the class with the decimal number
if (my $classID = opentrafficshaper::plugins::tc::getCIDFromTcClass($interface,
opentrafficshaper::plugins::tc::TC_ROOT_CLASS,$stat->{'_class_child'})
opentrafficshaper::plugins::tc::TC_ROOT_CLASS,$stat->{'TCClassChild'})
) {
$sid = opentrafficshaper::plugins::statistics::setSIDFromCID($interface,$classID);
} else {
$logger->log(LOG_WARN,"[TCSTATS] System traffic class '%s:%s' NOT FOUND",$stat->{'_class_parent'},
$stat->{'_class_child'}
$logger->log(LOG_WARN,"[TCSTATS] System traffic class '%s:%s' NOT FOUND",$stat->{'TCClassParent'},
$stat->{'TCClassChild'}
);
}
}
......@@ -273,14 +304,15 @@ sub _task_child_stdout
# Make sure we have the lid now
if (defined($sid)) {
# Build our submission
$stat->{'timestamp'} = $timestamp;
$stat->{'direction'} = $direction;
$stat->{'Timestamp'} = $timestamp;
$stat->{'Direction'} = $direction;
$taskData->{'stats'}->{$sid} = $stat;
$taskData->{'Stats'}->{$sid} = $stat;
}
}
# Child writes to STDERR
sub _task_child_stderr
{
......@@ -293,6 +325,7 @@ sub _task_child_stderr
}
# Child closed its handles, it won't communicate with us, so remove it
sub _task_child_close
{
......@@ -309,7 +342,7 @@ sub _task_child_close
}
# Push consolidated update through
$kernel->post("statistics" => "update" => $taskData->{'stats'});
$kernel->post("statistics" => "update" => $taskData->{'Stats'});
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/%s: Closed PID %s",$task_id,$task->PID);
......@@ -317,12 +350,10 @@ sub _task_child_close
delete($heap->{task_by_pid}->{$task->PID});
delete($heap->{task_by_wid}->{$task_id});
delete($heap->{task_data}->{$task_id});
# Fire up next tick
$kernel->delay('_tick' => TICK_PERIOD);
}
# Reap the dead child
sub _task_handle_SIGCHLD
{
......@@ -342,6 +373,7 @@ sub _task_handle_SIGCHLD
}
# Handle SIGINT
sub _task_handle_SIGINT
{
......@@ -359,5 +391,6 @@ sub _task_handle_SIGINT
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/configmanager.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: configmanager page
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -32,24 +32,35 @@ our (@ISA,@EXPORT,@EXPORT_OK);
use DateTime;
use HTML::Entities;
use HTTP::Status qw( :constants );
use HTTP::Status qw(
:constants
);
use URI::Escape;
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::utils qw(
use awitpt::util qw(
isNumber ISNUMBER_ALLOW_ZERO
parseFormContent
parseURIQuery
prettyUndef
);
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::plugins::configmanager qw(
getInterfaces
getInterfaceTrafficClasses
getInterfaceRate
getInterface
getTrafficClass
getAllTrafficClasses
getInterfaceTrafficClass
getEffectiveInterfaceTrafficClass2
changeInterfaceTrafficClass
getTrafficClassName
isInterfaceIDValid
isTrafficClassIDValid
);
......@@ -82,45 +93,27 @@ sub default
}
# Admin configuration
sub admin_config
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Items for our form...
my @formElements = qw(
FriendlyName
Identifier
ClassID
TrafficLimitTx TrafficLimitTxBurst
TrafficLimitRx TrafficLimitRxBurst
Notes
);
# Grab stuff we need
my $interfaces = getInterfaces();
my @interfaces = getInterfaces();
# Errors to display above the form
my @errors;
# Build content
my $content = "";
# Header
# Form header
$content .=<<EOF;
<!-- Config Tabs -->
<ul class="nav nav-tabs" id="configTabs">
<li class="active"><a href="#interfaces" data-toggle="tab">Interfaces</a></li>
<li><a href="#system" data-toggle="tab">System (TODO)</a></li>
</ul>
<!-- Tab panes -->
<div class="tab-content">
<div class="tab-pane active" id="interfaces">
<legend>Interface Rate Setup</legend>
EOF
# Title of the form, by default its an add form
my $formType = "Add";
my $formNoEdit = "";
# Form data
my $formData;
......@@ -129,11 +122,87 @@ EOF
if ($request->method eq "POST") {
# Parse form data
my $form = parseFormContent($request->content);
use Data::Dumper; warn "CONTENTDATA: ".Dumper($request->content);
use Data::Dumper; warn "FORMDATA: ".Dumper($form);
# Loop with rate changes
my $rateChanges = { };
foreach my $elementName (keys %{$form}) {
my $rateChange = $form->{$elementName};
# Skip over blanks
if ($rateChange->{'value'} =~ /^\s*$/) {
next;
}
# Split off the various components of the element name
my ($item,$interfaceID,$trafficClassID) = ($elementName =~ /^((?:CIR|Limit))\[([a-z0-9:.]+)\]\[([0-9]+)\]$/);
# Make sure everything is defined
if (!defined($item) || !defined($interfaceID) || !defined($trafficClassID)) {
push(@errors,"Invalid data received");
last;
}
# Check interface exists
if (!defined($interfaceID = isInterfaceIDValid($interfaceID))) {
push(@errors,"Invalid data received, interface ID is invalid");
last;
}
# Check class is valid
if (
!defined($trafficClassID = isNumber($trafficClassID,ISNUMBER_ALLOW_ZERO)) ||
($trafficClassID && !isTrafficClassIDValid($trafficClassID))
) {
push(@errors,"Invalid class ID received for interface [$interfaceID]");
last;
}
# Check value is valid
if (!defined($rateChange->{'value'} = isNumber($rateChange->{'value'}))) {
push(@errors,"Invalid value received for interface [$interfaceID], class [$trafficClassID]");
last;
}
$rateChanges->{$interfaceID}->{$trafficClassID}->{$item} = $rateChange->{'value'};
}
# FIXME - check speed does not exceed inteface speed
# Check if there are no errors
if (!@errors) {
# Loop with interfaces
foreach my $interfaceID (keys %{$rateChanges}) {
my $trafficClasses = $rateChanges->{$interfaceID};
# Loop with traffic classes
foreach my $trafficClassID (keys %{$trafficClasses}) {
my $trafficClass = $trafficClasses->{$trafficClassID};
# Set some additional items we need
$trafficClass->{'InterfaceID'} = $interfaceID;
$trafficClass->{'TrafficClassID'} = $trafficClassID;
# Push changes
changeInterfaceTrafficClass($trafficClass);
}
}
return (HTTP_TEMPORARY_REDIRECT,"/configmanager");
}
}
# Header
$content .=<<EOF;
<!-- Config Tabs -->
<ul class="nav nav-tabs" id="configTabs">
<li class="active"><a href="#interfaces" data-toggle="tab">Interfaces</a></li>
</ul>
<!-- Tab panes -->
<div class="tab-content">
<div class="tab-pane active" id="interfaces">
EOF
# Spit out errors if we have any
if (@errors > 0) {
foreach my $error (@errors) {
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
# Interfaces tab setup
$content .=<<EOF;
<br />
......@@ -141,14 +210,21 @@ EOF
<ul class="nav nav-tabs" id="configInterfaceTabs">
EOF
my $firstPaneActive = " active";
foreach my $interface (@{$interfaces}) {
foreach my $interfaceID (@interfaces) {
my $interface = getInterface($interfaceID);
my $encodedInterfaceID = encode_entities($interfaceID);
my $encodedInterfaceName = encode_entities($interface->{'Name'});
$content .=<<EOF;
<li class="$firstPaneActive"><a href="#interface$interface" data-toggle="tab">Interface: $interface</a></li>
<li class="$firstPaneActive">
<a href="#interface$encodedInterfaceID" data-toggle="tab">
Interface: $encodedInterfaceName
</a>
</li>
EOF
# No longer the first pane
$firstPaneActive = "";
$formData->{"MainTrafficLimitTx[$interface]"} = getInterfaceRate($interface);
}
$content .=<<EOF;
</ul>
......@@ -158,17 +234,31 @@ EOF
# Suck in list of interfaces
$firstPaneActive = " active";
foreach my $interface (@{$interfaces}) {
foreach my $interfaceID (@interfaces) {
my $interface = getInterface($interfaceID);
my $encodedInterfaceID = encode_entities($interfaceID);
my $encodedInterfaceName = encode_entities($interface->{'Name'});
# Root class
my $interfaceTrafficClass = getInterfaceTrafficClass($interfaceID,0);
my $effectiveInterfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClass->{'ID'});
my $encodedInterfaceLimit = encode_entities($effectiveInterfaceTrafficClass->{'Limit'});
# Interface tab
$content .=<<EOF;
<div class="tab-pane$firstPaneActive" id="interface$interface">
<div class="tab-pane$firstPaneActive" id="interface$encodedInterfaceID">
EOF
# No longer the first pane
$firstPaneActive = "";
# Sanitize params if we need to
foreach my $item (@formElements) {
$formData->{$item} = defined($formData->{$item}) ? encode_entities($formData->{$item}) : "";
if (defined($formData->{"Limit[$encodedInterfaceID][0]"})) {
$formData->{"Limit[$encodedInterfaceID][0]"} =
encode_entities($formData->{"Limit[$encodedInterfaceID][0]"});
} else {
$formData->{"Limit[$encodedInterfaceID][0]"} = "";
}
......@@ -183,52 +273,73 @@ EOF
#
$content .=<<EOF;
<br />
<legend>Main: $interface</legend>
<legend>Main: $encodedInterfaceName</legend>
<div class="form-group">
<label for="TrafficLimitTx" class="col-md-1 control-label">CIR</label>
<label for="Limit" class="col-md-1 control-label">Speed</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="MainTrafficLimitTx[$interface]" type="text" placeholder="CIR" class="form-control" value="$formData->{"MainTrafficLimitTx[$interface]"}" />
<input name="Limit[$encodedInterfaceID][0]" type="text"
placeholder="$encodedInterfaceLimit" class="form-control"
value="$formData->{"Limit[$encodedInterfaceID][0]"}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
<label for="TrafficLimitTxBurst" class="col-md-1 control-label">Limit</label>
<div class="col-md-3">
<div class="input-group">
<input name="MainTrafficLimitTxBurst[$interface]" type="text" placeholder="Limit" class="form-control" value="$formData->{'TrafficLimitTxBurst'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
EOF
my $classes = getInterfaceTrafficClasses($interface);
foreach my $class (sort { $a <=> $b } keys %{$classes}) {
my $className = getTrafficClassName($class);
my $classNameStr = encode_entities($className);
# Grab classes and loop
my @trafficClasses = getAllTrafficClasses();
foreach my $trafficClassID (sort { $a <=> $b } @trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
my $encodedTrafficClassID = encode_entities($trafficClassID);
my $encodedTrafficClassName = encode_entities($trafficClass->{'Name'});
$interfaceTrafficClass = getInterfaceTrafficClass($interfaceID,$trafficClassID);
$effectiveInterfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClass->{'ID'});
my $encodedInterfaceTrafficClassCIR = encode_entities($effectiveInterfaceTrafficClass->{'CIR'});
my $encodedInterfaceTrafficClassLimit = encode_entities($effectiveInterfaceTrafficClass->{'Limit'});
# Sanitize params if we need to
if (defined($formData->{"CIR[$encodedInterfaceID][$encodedTrafficClassID]"})) {
$formData->{"CIR[$encodedInterfaceID][$encodedTrafficClassID]"} =
encode_entities($formData->{"CIR[$encodedInterfaceID][$encodedTrafficClassID]"});
} else {
$formData->{"CIR[$encodedInterfaceID][$encodedTrafficClassID]"} = "";
}
if (defined($formData->{"Limit[$encodedInterfaceID][$encodedTrafficClassID]"})) {
$formData->{"Limit[$encodedInterfaceID][$encodedTrafficClassID]"} =
encode_entities($formData->{"Limit[$encodedInterfaceID][$encodedTrafficClassID]"});
} else {
$formData->{"Limit[$encodedInterfaceID][$encodedTrafficClassID]"} = "";
}
#
# Page content
#
$content .=<<EOF;
<legend>Class: $interface - $classNameStr</legend>
<legend>Class: $encodedInterfaceName - $encodedTrafficClassName</legend>
<div class="form-group">
<label for="TrafficLimitTx" class="col-md-1 control-label">CIR</label>
<label for="TxCIR" class="col-md-1 control-label">CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="ClassTrafficLimitTx[$interface] x y [$class]" type="text" placeholder="CIR" class="form-control" value="$formData->{'TrafficLimitTx'}" />
<input name="CIR[$encodedInterfaceID][$encodedTrafficClassID]" type="text"
placeholder="$encodedInterfaceTrafficClassCIR" class="form-control"
value="$formData->{"CIR[$encodedInterfaceID][$encodedTrafficClassID]"}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
<label for="TrafficLimitTxBurst" class="col-md-1 control-label">Limit</label>
<label for="TxLimit" class="col-md-1 control-label">Limit</label>
<div class="col-md-3">
<div class="input-group">
<input name="ClassTrafficLimitTxBurst[$interface][$class]" type="text" placeholder="Limit" class="form-control" value="$formData->{'TrafficLimitTxBurst'}" />
<input name="Limit[$encodedInterfaceID][$encodedTrafficClassID]" type="text"
placeholder="$encodedInterfaceTrafficClassLimit" class="form-control"
value="$formData->{"Limit[$encodedInterfaceID][$encodedTrafficClassID]"}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -256,9 +367,6 @@ EOF
EOF
$content .=<<EOF;
<div class="tab-pane" id="system">
Work In Progress
</div>
</div>
EOF
......
opentrafficshaper/plugins/webserver/pages/index.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: index page
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -48,14 +48,10 @@ sub _catchall
goto END;
}
($res,$content,$opts) = opentrafficshaper::plugins::webserver::pages::statistics::_dashboard($kernel,$globals,
$client_session_id,$request
);
END:
return ($res,$content,$opts);
return (HTTP_TEMPORARY_REDIRECT,"statistics/dashboard");
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/limits.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: limits page
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -32,28 +32,34 @@ our (@ISA,@EXPORT,@EXPORT_OK);
use DateTime;
use HTML::Entities;
use HTTP::Status qw( :constants );
use URI::Escape qw( uri_escape );
use HTTP::Status qw(
:constants
);
use NetAddr::IP;
use URI::Escape qw(
uri_escape
);
use URI::QueryParam;
use Storable qw( dclone );
use Storable qw(
dclone
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::utils qw(
use awitpt::util qw(
parseURIQuery
parseFormContent
isUsername
isIP
isNumber
isUsername ISUSERNAME_ALLOW_ATSIGN
isNumber ISNUMBER_ALLOW_ZERO
prettyUndef
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::plugins::configmanager qw(
getPools
getPool
getPoolByName
getPoolShaperState
isPoolOverridden
isPoolReady
getPoolMembers
......@@ -62,19 +68,23 @@ use opentrafficshaper::plugins::configmanager qw(
getPoolMemberShaperState
isPoolMemberReady
getOverrides
getOverride
getPoolOverrides
getPoolOverride
getInterfaceGroup
getInterfaceGroups
isInterfaceGroupIDValid
getMatchPriorities
isMatchPriorityIDValid
getTrafficClasses getTrafficClassName
getTrafficClass
getTrafficClasses
isTrafficClassIDValid
);
use opentrafficshaper::util qw(
isIPv46 isIPv46CIDR
);
# Sidebar menu options for this module
......@@ -101,11 +111,11 @@ my $menu = [
'items' => [
{
'name' => 'List Overrides',
'link' => 'override-list'
'link' => 'pool-override-list'
},
{
'name' => 'Add Override',
'link' => 'override-add'
'link' => 'pool-override-add'
}
]
},
......@@ -146,6 +156,7 @@ sub pool_list
<th>Friendly Name</th>
<th>Name</th>
<th>Expires</th>
<th>Members</th>
<th></th>
<th>Class</th>
<th>CIR (Kbps)</th>
......@@ -173,23 +184,23 @@ EOF
# Get a nice last update string
my $lastUpdate = DateTime->from_epoch( epoch => $pool->{'LastUpdate'} )->iso8601();
my $cirStr = sprintf('%s/%s',prettyUndef($pool->{'TrafficLimitTx'}),prettyUndef($pool->{'TrafficLimitRx'}));
my $limitStr = sprintf('%s/%s',prettyUndef($pool->{'TrafficLimitTxBurst'}),prettyUndef($pool->{'TrafficLimitRxBurst'}));
my $igidEscaped = uri_escape($pool->{'InterfaceGroupID'});
my $pidEscaped = uri_escape($pool->{'ID'});
my $poolCIRStr = encode_entities(sprintf('%s/%s',prettyUndef($pool->{'TxCIR'}),prettyUndef($pool->{'RxCIR'})));
my $poolLimitStr = encode_entities(sprintf('%s/%s',prettyUndef($pool->{'TxLimit'}),prettyUndef($pool->{'RxLimit'})));
my $poolFriendlyName = (defined($pool->{'FriendlyName'}) && $pool->{'FriendlyName'} ne "") ? $pool->{'FriendlyName'} :
$pool->{'Name'};
my $poolFriendlyNameEncoded = encode_entities($poolFriendlyName);
my $poolNameEncoded = encode_entities($pool->{'Name'});
my $friendlyName = (defined($pool->{'FriendlyName'}) && $pool->{'FriendlyName'} ne "") ? $pool->{'FriendlyName'} :
$pool->{'Name'};
my $friendlyNameEncoded = encode_entities($friendlyName);
my $poolExpiresStr = encode_entities(
($pool->{'Expires'} > 0) ? DateTime->from_epoch( epoch => $pool->{'Expires'} )->iso8601() : '-never-'
);
my $nameEncoded = encode_entities($pool->{'Name'});
my $nameEscaped = uri_escape($pool->{'Name'});
my $poolMemberCount = getPoolMembers($pool->{'ID'});
my $expiresStr = ($pool->{'Expires'} > 0) ? DateTime->from_epoch( epoch => $pool->{'Expires'} )->iso8601() : '-never-';
my $classStr = getTrafficClassName($pool->{'ClassID'});
my $trafficClass = getTrafficClass($pool->{'TrafficClassID'});
my $trafficClassNameEncoded = encode_entities($trafficClass->{'Name'});
# Display relevant icons depending on pool status
my $icons = "";
......@@ -205,26 +216,31 @@ EOF
# if ($pool->{'Status'} eq 'conflict') {
# $icons .= '<span class="glyphicon glyphicon-random" />';
# }
# if ($pool->{'Status'} eq 'conflict') {
# $icons .= '<span class="glyphicon glyphicon-edit" />';
# }
if (isPoolOverridden($pool->{'ID'})) {
$icons .= '<span class="glyphicon glyphicon-edit" />';
}
my $urlStatsPool = sprintf('/statistics/by-pool?pool=%s',uri_escape("$pool->{'InterfaceGroupID'}:$pool->{'Name'}"));
my $urlPoolEdit = sprintf('/limits/pool-edit?pid=%s',uri_escape($pool->{'ID'}));
my $urlPoolMemberList = sprintf('/limits/poolmember-list?pid=%s',uri_escape($pool->{'ID'}));
my $urlPoolRemove = sprintf('/limits/pool-remove?pid=%s',uri_escape($pool->{'ID'}));
$content .= <<EOF;
<tr>
<td>$icons</td>
<td>$friendlyNameEncoded</td>
<td>$nameEncoded</td>
<td>$expiresStr</td>
<td>$poolFriendlyNameEncoded</td>
<td>$poolNameEncoded</td>
<td>$poolExpiresStr</td>
<td class="align-right">$poolMemberCount</td>
<td><span class="glyphicon glyphicon-arrow-right" /></td>
<td>$classStr</td>
<td>$cirStr</td>
<td>$limitStr</td>
<td class="align-center">$trafficClassNameEncoded</td>
<td class="align-center">$poolCIRStr</td>
<td class="align-center">$poolLimitStr</td>
<td>
<a href="/statistics/by-pool?pool=$igidEscaped:$nameEscaped"><span class="glyphicon glyphicon-stats"></span></a>
<a href="/limits/pool-edit?pid=$pidEscaped"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="/limits/poolmember-list?pid=$pidEscaped"><span class="glyphicon glyphicon-link"></span></a>
<a href="/limits/pool-remove?pid=$pidEscaped"><span class="glyphicon glyphicon-remove"></span></a>
<a href="$urlStatsPool"><span class="glyphicon glyphicon-stats"></span></a>
<a href="$urlPoolEdit"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="$urlPoolMemberList"><span class="glyphicon glyphicon-link"></span></a>
<a href="$urlPoolRemove"><span class="glyphicon glyphicon-remove"></span></a>
</td>
</tr>
EOF
......@@ -234,7 +250,7 @@ EOF
if (!@pools) {
$content .=<<EOF;
<tr class="info">
<td colspan="8"><p class="text-center">No Results</p></td>
<td colspan="10"><p class="text-center">No Results</p></td>
</tr>
EOF
}
......@@ -243,10 +259,10 @@ EOF
$content .=<<EOF;
</tbody>
</table>
<span class="glyphicon glyphicon-time" /> - Processing,
<span class="glyphicon glyphicon-edit" /> - Override,
<span class="glyphicon glyphicon-import" /> - Being Added,
<span class="glyphicon glyphicon-trash" /> - Being Removed,
<span class="glyphicon glyphicon-time" /> - Processing <br/>
<span class="glyphicon glyphicon-edit" /> - Override <br/>
<span class="glyphicon glyphicon-import" /> - Being Added <br/>
<span class="glyphicon glyphicon-trash" /> - Being Removed <br/>
<span class="glyphicon glyphicon-random" /> - Conflicts
EOF
......@@ -254,6 +270,7 @@ EOF
}
# Pool add/edit action
sub pool_addedit
{
......@@ -271,9 +288,9 @@ sub pool_addedit
FriendlyName
Name
InterfaceGroupID
ClassID
TrafficLimitTx TrafficLimitTxBurst
TrafficLimitRx TrafficLimitRxBurst
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
......@@ -302,7 +319,7 @@ sub pool_addedit
if (defined($queryParams->{'pid'})) {
# Check if we can grab the pool
if (!defined($pool = getPool($queryParams->{'pid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"limits");
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
}
......@@ -314,7 +331,7 @@ sub pool_addedit
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
......@@ -326,7 +343,7 @@ sub pool_addedit
if (defined($form->{'submit'}) && $form->{'submit'}->{'value'} eq "Edit") {
# Check pool exists
if (!defined($pool)) {
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
$formData->{'ID'} = $pool->{'ID'};
......@@ -348,7 +365,7 @@ sub pool_addedit
# Woops ... no query string?
} elsif (keys %{$queryParams} > 0) {
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
......@@ -359,7 +376,7 @@ sub pool_addedit
# Check POST data
my $name;
if (!defined($name = isUsername($formData->{'Name'}))) {
if (!defined($name = isUsername($formData->{'Name'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Name is not valid");
}
my $interfaceGroupID;
......@@ -369,18 +386,18 @@ sub pool_addedit
if ($formType ne "Edit" && getPoolByName($interfaceGroupID,$name)) {
push(@errors,"A pool with the same name already exists");
}
my $classID;
if (!defined($classID = isTrafficClassIDValid($formData->{'ClassID'}))) {
my $trafficClassID;
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
my $trafficLimitTx = isNumber($formData->{'TrafficLimitTx'});
my $trafficLimitTxBurst = isNumber($formData->{'TrafficLimitTxBurst'});
if (!defined($trafficLimitTx) && !defined($trafficLimitTxBurst)) {
my $txCIR = isNumber($formData->{'TxCIR'});
my $txLimit = isNumber($formData->{'TxLimit'});
if (!defined($txCIR) && !defined($txLimit)) {
push(@errors,"A valid download CIR and/or limit is required");
}
my $trafficLimitRx = isNumber($formData->{'TrafficLimitRx'});
my $trafficLimitRxBurst = isNumber($formData->{'TrafficLimitRxBurst'});
if (!defined($trafficLimitRx) && !defined($trafficLimitRxBurst)) {
my $rxCIR = isNumber($formData->{'RxCIR'});
my $rxLimit = isNumber($formData->{'RxLimit'});
if (!defined($rxCIR) && !defined($rxLimit)) {
push(@errors,"A valid upload CIR and/or limit is required");
}
......@@ -393,7 +410,7 @@ sub pool_addedit
my $expires = 0;
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'}))) {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
......@@ -431,11 +448,11 @@ sub pool_addedit
'FriendlyName' => $friendlyName,
'Name' => $name,
'InterfaceGroupID' => $interfaceGroupID,
'ClassID' => $classID,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
};
......@@ -457,14 +474,14 @@ sub pool_addedit
$formType,
prettyUndef($name),
prettyUndef($interfaceGroupID),
prettyUndef($classID),
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
prettyUndef($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
......@@ -485,35 +502,43 @@ EOF
# Spit out errors if we have any
if (@errors > 0) {
foreach my $error (@errors) {
$content .= '<div class="alert alert-danger">'.$error.'</div>';
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
# Generate interface group list
my $interfaceGroups = getInterfaceGroups();
my @interfaceGroups = sort(getInterfaceGroups());
my $interfaceGroupStr = "";
foreach my $interfaceGroupID (sort keys %{$interfaceGroups}) {
foreach my $interfaceGroupID (@interfaceGroups) {
my $interfaceGroup = getInterfaceGroup($interfaceGroupID);
my $interfaceGroupIDEncoded = encode_entities($interfaceGroupID);
my $interfaceGroupNameEncoded = encode_entities($interfaceGroup->{'Name'});
# Check if this item is selected
my $selected = "";
if ($formData->{'InterfaceGroupID'} ne "" && $formData->{'InterfaceGroupID'} eq $interfaceGroupID) {
$selected = "selected";
}
# And build the options
$interfaceGroupStr .= '<option value="'.$interfaceGroupID.'" '.$selected.'>'.
$interfaceGroups->{$interfaceGroupID}->{'name'}.'</option>';
$interfaceGroupStr .= '<option value="'.$interfaceGroupIDEncoded.'" '.$selected.'>'.
$interfaceGroupNameEncoded.'</option>';
}
# Generate traffic class list
my $trafficClasses = getTrafficClasses();
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $classID (sort keys %{$trafficClasses}) {
foreach my $trafficClassID (@trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
my $trafficClassIDEncoded = encode_entities($trafficClassID);
my $trafficClassNameEncoded = encode_entities($trafficClass->{'Name'});
# Process selections nicely
my $selected = "";
if ($formData->{'ClassID'} ne "" && $formData->{'ClassID'} eq $classID) {
if ($formData->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$classID.'" '.$selected.'>'.$trafficClasses->{$classID}.'</option>';
$trafficClassStr .= '<option value="'.$trafficClassIDEncoded.'" '.$selected.'>'.$trafficClassNameEncoded.'</option>';
}
# Generate expires modifiers list
......@@ -529,8 +554,8 @@ EOF
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.$expiresModifiers->{$expireModifier}.
'</option>';
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# Blank expires if its 0
......@@ -570,58 +595,58 @@ EOF
</div>
</div>
<div class="form-group">
<label for="ClassID" class="col-md-2 control-label">Traffic Class</label>
<label for="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-2">
<select name="ClassID" class="form-control">
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitTx" class="col-md-2 control-label">Download CIR</label>
<label for="TxCIR" class="col-md-2 control-label">Download CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitTx" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TrafficLimitTx'}" />
<input name="TxCIR" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitTxBurst" class="col-md-2 control-label">Download Limit</label>
<label for="TxLimit" class="col-md-2 control-label">Download Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitTxBurst" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TrafficLimitTxBurst'}" />
<input name="TxLimit" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitRx" class="col-md-2 control-label">Upload CIR</label>
<label for="RxCIR" class="col-md-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitRx" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'TrafficLimitRx'}" />
<input name="RxCIR" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'RxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitRxBurst" class="col-md-2 control-label">Upload Limit</label>
<label for="RxLimit" class="col-md-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitRxBurst" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'TrafficLimitRxBurst'}" />
<input name="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -661,6 +686,7 @@ EOF
}
# Pool remove action
sub pool_remove
{
......@@ -716,18 +742,16 @@ EOF
# Post the removal
$kernel->post("configmanager" => "pool_remove" => $pool->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Make the pool ID safe for HTML
my $encodedPID = encode_entities($queryParams->{'pid'}->{'value'});
# Make the friendly name HTML safe
my $encodedName = encode_entities($pool->{'Name'});
my $encodedPoolName = encode_entities($pool->{'Name'});
# Build our confirmation dialog
$content .= <<EOF;
<div class="alert alert-danger">
Are you very sure you wish to remove pool for "$encodedName"?
Are you very sure you wish to remove pool for "$encodedPoolName"?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
......@@ -740,6 +764,7 @@ END:
}
# Pool member list page/action
sub poolmember_list
{
......@@ -780,14 +805,13 @@ EOF
# Grab pools members
my @poolMembers = getPoolMembers($pool->{'ID'});
# Make the pool ID safe for HTML
my $pidEscaped = encode_entities($pool->{'ID'});
my $poolFriendlyName = (defined($pool->{'FriendlyName'}) && $pool->{'FriendlyName'} ne "") ? $pool->{'FriendlyName'} :
$pool->{'Name'};
my $poolFriendlyNameEncoded = encode_entities($poolFriendlyName);
my $poolNameEncoded = encode_entities($pool->{'Name'});
my $urlPoolMemberAdd = sprintf('poolmember-add?pid=%s',uri_escape($pool->{'ID'}));
# Menu
$customMenu = [
{
......@@ -795,7 +819,7 @@ EOF
'items' => [
{
'name' => 'Add Pool Member',
'link' => "poolmember-add?pid=$pidEscaped",
'link' => $urlPoolMemberAdd
},
],
},
......@@ -814,6 +838,7 @@ EOF
<th>Friendly Name</th>
<th>Username</th>
<th>IP</th>
<th>NAT</th>
<th>Created</th>
<th>Updated</th>
<th>Expires</th>
......@@ -831,26 +856,30 @@ EOF
}
# Get a nice last update string
my $pmidEscaped = uri_escape($poolMember->{'ID'});
my $friendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
my $poolMemberFriendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
$poolMember->{'FriendlyName'} : $poolMember->{'Username'};
my $friendlyNameEncoded = encode_entities($friendlyName);
my $poolMemberFriendlyNameEncoded = encode_entities($poolMemberFriendlyName);
my $poolMemberUsernameEncoded = encode_entities($poolMember->{'Username'});
my $usernameEncoded = encode_entities($poolMember->{'Username'});
my $poolMemberIPEncoded = encode_entities($poolMember->{'IPAddress'});
my $poolMemberIPNATEncoded = encode_entities(
(defined($poolMember->{'IPNATAddress'}) && $poolMember->{'IPNATAddress'} ne "") ? $poolMember->{'IPNATAddress'} : '-none-'
);
my $natIcons = (defined($poolMember->{'IPNATInbound'}) && $poolMember->{'IPNATInbound'}) ? '<span class="glyphicon glyphicon-resize-vertical" />' : '';
my $ipEncoded = encode_entities($poolMember->{'IPAddress'});
my $poolMemberCreatedStr = encode_entities(($poolMember->{'Created'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'Created'} )->iso8601() : '-never-');
my $poolMemberUpdatedStr = encode_entities(($poolMember->{'LastUpdate'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'LastUpdate'} )->iso8601() : '-never-');
my $poolMemberExpiresStr = encode_entities(($poolMember->{'Expires'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'Expires'} )->iso8601() : '-never-');
my $createdStr = ($poolMember->{'Created'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'Created'} )->iso8601() : '-never-';
my $updatedStr = ($poolMember->{'LastUpdate'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'LastUpdate'} )->iso8601() : '-never-';
my $expiresStr = ($poolMember->{'Expires'} > 0) ?
DateTime->from_epoch( epoch => $poolMember->{'Expires'} )->iso8601() : '-never-';
my $poolMemberShaperState = getPoolMemberShaperState($poolMember->{'ID'});
# Display relevant icons depending on pool status
my $icons = "";
if (!(getPoolMemberShaperState($poolMember->{'ID'}) & SHAPER_LIVE)) {
if (!($poolMemberShaperState & SHAPER_LIVE)) {
$icons .= '<span class="glyphicon glyphicon-time" />';
}
if ($poolMember->{'Status'} == CFGM_NEW) {
......@@ -859,25 +888,26 @@ EOF
if ($poolMember->{'Status'} == CFGM_OFFLINE) {
$icons .= '<span class="glyphicon glyphicon-trash" />';
}
# if ($poolMember->{'Status'} eq 'conflict') {
# $icons .= '<span class="glyphicon glyphicon-random" />';
# }
# if ($pool->{'Status'} eq 'conflict') {
# $icons .= '<span class="glyphicon glyphicon-edit" />';
# }
if ($poolMemberShaperState & SHAPER_CONFLICT) {
$icons .= '<span class="glyphicon glyphicon-random" />';
}
my $urlPoolMemberEdit = sprintf('/limits/poolmember-edit?pmid=%s',uri_escape($poolMember->{'ID'}));
my $urlPoolMemberRemove = sprintf('/limits/poolmember-remove?pmid=%s',uri_escape($poolMember->{'ID'}));
$content .= <<EOF;
<tr>
<td>$icons</td>
<td>$friendlyNameEncoded</td>
<td>$usernameEncoded</td>
<td>$ipEncoded</td>
<td>$createdStr</td>
<td>$updatedStr</td>
<td>$expiresStr</td>
<td>$poolMemberFriendlyNameEncoded</td>
<td>$poolMemberUsernameEncoded</td>
<td>$poolMemberIPEncoded</td>
<td>$natIcons$poolMemberIPNATEncoded</td>
<td>$poolMemberCreatedStr</td>
<td>$poolMemberUpdatedStr</td>
<td>$poolMemberExpiresStr</td>
<td>
<a href="/limits/poolmember-edit?pmid=$pmidEscaped"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="/limits/poolmember-remove?pmid=$pmidEscaped"><span class="glyphicon glyphicon-remove"></span></a>
<a href="$urlPoolMemberEdit"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="$urlPoolMemberRemove"><span class="glyphicon glyphicon-remove"></span></a>
</td>
</tr>
EOF
......@@ -896,10 +926,10 @@ EOF
$content .=<<EOF;
</tbody>
</table>
<span class="glyphicon glyphicon-time" /> - Processing,
<span class="glyphicon glyphicon-edit" /> - Override,
<span class="glyphicon glyphicon-import" /> - Being Added,
<span class="glyphicon glyphicon-trash" /> - Being Removed,
<span class="glyphicon glyphicon-time" /> - Processing <br/>
<span class="glyphicon glyphicon-edit" /> - Override <br/>
<span class="glyphicon glyphicon-import" /> - Being Added <br/>
<span class="glyphicon glyphicon-trash" /> - Being Removed <br/>
<span class="glyphicon glyphicon-random" /> - Conflicts
EOF
......@@ -908,6 +938,7 @@ END:
}
# Pool member add/edit action
sub poolmember_addedit
{
......@@ -923,7 +954,7 @@ sub poolmember_addedit
# Items for our form...
my @formElements = qw(
FriendlyName
Username IPAddress
Username IPAddress IPNATAddress IPNATInbound
MatchPriorityID
Expires inputExpires.modifier
Notes
......@@ -941,6 +972,7 @@ sub poolmember_addedit
# Title of the form, by default its an add form
my $formType = "Add";
my $formNoEdit = "";
my $checkboxNoEdit = "";
# Form data
my $formData;
# Pool
......@@ -955,7 +987,7 @@ sub poolmember_addedit
if (defined($queryParams->{'pmid'})) {
# Check if we can grab the pool member
if (!defined($poolMember = getPoolMember($queryParams->{'pmid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"limits");
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
$pool = getPool($poolMember->{'PoolID'});
......@@ -964,7 +996,7 @@ sub poolmember_addedit
} elsif (defined($queryParams->{'pid'})) {
# Check if we can grab the pool
if (!defined($pool = getPool($queryParams->{'pid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"limits");
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
}
......@@ -977,15 +1009,13 @@ sub poolmember_addedit
if (defined($form->{'cancel'})) {
# If the pool member is defined, rededirect to pool member list
if (defined($poolMember)) {
my $pidEscaped = uri_escape($poolMember->{'PoolID'});
return (HTTP_TEMPORARY_REDIRECT,"limits/poolmember-list?pid=$pidEscaped");
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
# Do same for pool
} elsif (defined($pool)) {
my $pidEscaped = uri_escape($pool->{'ID'});
return (HTTP_TEMPORARY_REDIRECT,"limits/poolmember-list?pid=$pidEscaped");
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
}
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
......@@ -997,16 +1027,17 @@ sub poolmember_addedit
if (defined($form->{'submit'}) && $form->{'submit'}->{'value'} eq "Edit") {
# If there is no pool member on submit, redirect<F7>
if (!defined($poolMember)) {
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
$formData->{'ID'} = $poolMember->{'ID'};
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
}
# Maybe we were given an override key as a parameter? this would be an edit form
# Maybe we were given a pool override key as a parameter? this would be an edit form
} elsif ($request->method eq "GET") {
# If we got a pool member, this is an edit
if (defined($poolMember)) {
......@@ -1018,10 +1049,11 @@ sub poolmember_addedit
# Lastly if we were given a key, this is actually an edit
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
# Woops ... no query string?
} elsif (!defined($pool)) {
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
......@@ -1031,13 +1063,27 @@ sub poolmember_addedit
# Check POST data
my $username;
if (!defined($username = isUsername($formData->{'Username'}))) {
if (!defined($username = isUsername($formData->{'Username'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Username is not valid");
}
my $ipAddress;
if (!defined($ipAddress = isIP($formData->{'IPAddress'}))) {
if (!defined($ipAddress = isIPv46CIDR($formData->{'IPAddress'}))) {
push(@errors,"IP address is not valid");
}
my $ipNATAddress;
if (defined($formData->{'IPNATAddress'}) && $formData->{'IPNATAddress'} ne "") {
if (!defined($ipNATAddress = isIPv46($formData->{'IPNATAddress'}))) {
push(@errors,"IP NAT address is not valid");
}
}
my $ipNATInbound;
if (defined($formData->{'IPNATInbound'}) && $formData->{'IPNATInbound'} ne "") {
if (defined($ipNATAddress)) {
$ipNATInbound = "yes";
} else {
push(@errors,"Cannot NAT inbound traffic if no NAT address is set");
}
}
my $matchPriorityID;
if (!defined($matchPriorityID = isMatchPriorityIDValid($formData->{'MatchPriorityID'}))) {
push(@errors,"Match priority is not valid");
......@@ -1055,7 +1101,7 @@ sub poolmember_addedit
my $expires = 0;
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'}))) {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
......@@ -1092,6 +1138,8 @@ sub poolmember_addedit
'FriendlyName' => $friendlyName,
'Username' => $username,
'IPAddress' => $ipAddress,
'IPNATAddress' => $ipNATAddress,
'IPNATInbound' => $ipNATInbound,
'GroupID' => 1,
'MatchPriorityID' => $matchPriorityID,
'Expires' => $expires,
......@@ -1110,17 +1158,18 @@ sub poolmember_addedit
$kernel->post("configmanager" => $cEvent => $poolMemberData);
$logger->log(LOG_INFO,'[WEBSERVER/POOLMEMBER] Account: %s, User: %s, IP: %s, Group: %s, MatchPriority: %s, Pool: %s',
$logger->log(LOG_INFO,'[WEBSERVER/POOLMEMBER] Account: %s, User: %s, IP: %s, NAT: %s (inbound: %s), Group: %s, MatchPriority: %s, Pool: %s',
$formType,
prettyUndef($username),
prettyUndef($ipAddress),
prettyUndef($ipNATAddress),
prettyUndef($ipNATInbound),
prettyUndef(undef),
prettyUndef($matchPriorityID),
prettyUndef($pool->{'ID'}),
);
my $pidEscaped = uri_escape($pool->{'ID'});
return (HTTP_TEMPORARY_REDIRECT,"limits/poolmember-list?pid=$pidEscaped");
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
}
}
......@@ -1157,7 +1206,7 @@ EOF
# Spit out errors if we have any
if (@errors > 0) {
foreach my $error (@errors) {
$content .= '<div class="alert alert-danger">'.$error.'</div>';
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
......@@ -1192,10 +1241,14 @@ EOF
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.$expiresModifiers->{$expireModifier}.
'</option>';
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# If we have IPNATInbound set, we need to set it to checked
if (defined($formData->{'IPNATInbound'}) && $formData->{'IPNATInbound'} ne "") {
$formData->{'IPNATInbound'} = "checked";
}
# Blank expires if its 0
if (defined($formData->{'Expires'}) && $formData->{'Expires'} eq "0") {
$formData->{'Expires'} = "";
......@@ -1232,6 +1285,16 @@ EOF
</div>
</div>
</div>
<div class="form-group">
<label for="IPNATAddress" class="col-md-2 control-label">NAT Address</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="IPNATAddress" type="text" placeholder="NAT Address" class="form-control"
value="$formData->{'IPNATAddress'}" $formNoEdit />
<input name="IPNATInbound" type="checkbox" $formData->{'IPNATInbound'} $checkboxNoEdit /> NAT Inbound
</div>
</div>
</div>
<div class="form-group">
<label for="MatchPriorityID" class="col-md-2 control-label">Match Priority</label>
<div class="row">
......@@ -1276,6 +1339,7 @@ EOF
}
# Pool member remove action
sub poolmember_remove
{
......@@ -1313,7 +1377,7 @@ EOF
}
# Make the pool ID safe for HTML
my $pidEscaped = encode_entities($poolMember->{'PoolID'});
my $urlPoolMemberAdd = sprintf('/limits/poolmember-add?pid=%s',encode_entities($poolMember->{'PoolID'}));
# Menu
$customMenu = [
......@@ -1322,7 +1386,7 @@ EOF
'items' => [
{
'name' => 'Add Pool Member',
'link' => "poolmember-add?pid=$pidEscaped",
'link' => $urlPoolMemberAdd
},
],
},
......@@ -1339,19 +1403,19 @@ EOF
# Post the removal
$kernel->post("configmanager" => "poolmember_remove" => $poolMember->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,"limits/poolmember-list?pid=$pidEscaped");
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$poolMember->{'PoolID'}));
}
# Make the friendly name HTML safe
my $friendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
my $poolMemberFriendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
$poolMember->{'FriendlyName'} : $poolMember->{'Username'};
my $friendlyNameEncoded = encode_entities($friendlyName);
my $usernameEncoded = encode_entities($poolMember->{'Username'});
my $poolMemberFriendlyNameEncoded = encode_entities($poolMemberFriendlyName);
my $poolMemberUsernameEncoded = encode_entities($poolMember->{'Username'});
# Build our confirmation dialog
$content .= <<EOF;
<div class="alert alert-danger">
Are you very sure you wish to remove pool member "$friendlyNameEncoded" [$usernameEncoded]?
Are you very sure you wish to remove pool member "$poolMemberFriendlyNameEncoded" [$poolMemberUsernameEncoded]?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
......@@ -1364,6 +1428,7 @@ END:
}
# Add action
sub limit_add
{
......@@ -1379,12 +1444,12 @@ sub limit_add
# Items for our form...
my @formElements = qw(
FriendlyName
Username IPAddress
Username IPAddress IPNATAddress IPNATInbound
InterfaceGroupID
MatchPriorityID
ClassID
TrafficLimitTx TrafficLimitTxBurst
TrafficLimitRx TrafficLimitRxBurst
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
......@@ -1409,7 +1474,7 @@ sub limit_add
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
......@@ -1425,13 +1490,27 @@ sub limit_add
# Check POST data
my $username;
if (!defined($username = isUsername($formData->{'Username'}))) {
if (!defined($username = isUsername($formData->{'Username'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Username is not valid");
}
my $ipAddress;
if (!defined($ipAddress = isIP($formData->{'IPAddress'}))) {
if (!defined($ipAddress = isIPv46CIDR($formData->{'IPAddress'}))) {
push(@errors,"IP address is not valid");
}
my $ipNATAddress;
if (defined($formData->{'IPNATAddress'}) && $formData->{'IPNATAddress'} ne "") {
if (!defined($ipNATAddress = isIPv46($formData->{'IPNATAddress'}))) {
push(@errors,"NAT address is not valid");
}
}
my $ipNATInbound;
if (defined($formData->{'IPNATInbound'}) && $formData->{'IPNATInbound'} ne "") {
if (defined($ipNATAddress)) {
$ipNATInbound = "yes";
} else {
push(@errors,"Cannot NAT inbound traffic if no NAT address is set");
}
}
my $interfaceGroupID;
if (!defined($interfaceGroupID = isInterfaceGroupIDValid($formData->{'InterfaceGroupID'}))) {
push(@errors,"Interface group is not valid");
......@@ -1440,24 +1519,24 @@ sub limit_add
if (!defined($matchPriorityID = isMatchPriorityIDValid($formData->{'MatchPriorityID'}))) {
push(@errors,"Match priority is not valid");
}
my $classID;
if (!defined($classID = isTrafficClassIDValid($formData->{'ClassID'}))) {
my $trafficClassID;
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
my $trafficLimitTx = isNumber($formData->{'TrafficLimitTx'});
my $trafficLimitTxBurst = isNumber($formData->{'TrafficLimitTxBurst'});
if (!defined($trafficLimitTx) && !defined($trafficLimitTxBurst)) {
my $txCIR = isNumber($formData->{'TxCIR'});
my $txLimit = isNumber($formData->{'TxLimit'});
if (!defined($txCIR) && !defined($txLimit)) {
push(@errors,"A valid download CIR and/or limit is required");
}
my $trafficLimitRx = isNumber($formData->{'TrafficLimitRx'});
my $trafficLimitRxBurst = isNumber($formData->{'TrafficLimitRxBurst'});
if (!defined($trafficLimitRx) && !defined($trafficLimitRxBurst)) {
my $rxCIR = isNumber($formData->{'RxCIR'});
my $rxLimit = isNumber($formData->{'RxLimit'});
if (!defined($rxCIR) && !defined($rxLimit)) {
push(@errors,"A valid upload CIR and/or limit is required");
}
my $expires = 0;
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'}))) {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
......@@ -1494,14 +1573,16 @@ sub limit_add
'FriendlyName' => $friendlyName,
'Username' => $username,
'IPAddress' => $ipAddress,
'IPNATAddress' => $ipNATAddress,
'IPNATInbound' => $ipNATInbound,
'GroupID' => 1,
'InterfaceGroupID' => $interfaceGroupID,
'MatchPriorityID' => $matchPriorityID,
'ClassID' => $classID,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
};
......@@ -1512,21 +1593,23 @@ sub limit_add
$kernel->post("configmanager" => "limit_add" => $limit);
$logger->log(LOG_INFO,"[WEBSERVER/LIMITS] New User: %s, IP: %s, Group: %s, InterfaceGroup: %s, MatchPriority: %s, ".
$logger->log(LOG_INFO,"[WEBSERVER/LIMITS] New User: %s, IP: %s, NAT: %s (inbound: %s), Group: %s, InterfaceGroup: %s, MatchPriority: %s, ".
"Class: %s, Limits: %s/%s, Burst: %s/%s",
prettyUndef($username),
prettyUndef($ipAddress),
prettyUndef($ipNATAddress),
prettyUndef($ipNATInbound),
prettyUndef(undef),
prettyUndef($interfaceGroupID),
prettyUndef($matchPriorityID),
prettyUndef($classID),
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
prettyUndef($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
......@@ -1547,22 +1630,24 @@ EOF
# Spit out errors if we have any
if (@errors > 0) {
foreach my $error (@errors) {
$content .= '<div class="alert alert-danger">'.$error.'</div>';
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
# Generate interface group list
my $interfaceGroups = getInterfaceGroups();
my @interfaceGroups = sort(getInterfaceGroups());
my $interfaceGroupStr = "";
foreach my $interfaceGroupID (sort keys %{$interfaceGroups}) {
foreach my $interfaceGroupID (@interfaceGroups) {
my $interfaceGroup = getInterfaceGroup($interfaceGroupID);
# Process selections nicely
my $selected = "";
if ($formData->{'InterfaceGroupID'} ne "" && $formData->{'InterfaceGroupID'} eq $interfaceGroupID) {
$selected = "selected";
}
# And build the options
$interfaceGroupStr .= '<option value="'.$interfaceGroupID.'" '.$selected.'>'.
$interfaceGroups->{$interfaceGroupID}->{'name'}.'</option>';
$interfaceGroupStr .= '<option value="'.encode_entities($interfaceGroupID).'" '.$selected.'>'.
encode_entities($interfaceGroup->{'Name'}).'</option>';
}
# Generate match priority list
......@@ -1579,21 +1664,24 @@ EOF
$selected = "selected";
}
# And build the options
$matchPriorityStr .= '<option value="'.$matchPriorityID.'" '.$selected.'>'.$matchPriorities->{$matchPriorityID}.
'</option>';
$matchPriorityStr .= '<option value="'.encode_entities($matchPriorityID).'" '.$selected.'>'.
encode_entities($matchPriorities->{$matchPriorityID}).'</option>';
}
# Generate traffic class list
my $trafficClasses = getTrafficClasses();
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $classID (sort keys %{$trafficClasses}) {
foreach my $trafficClassID (@trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
# Process selections nicely
my $selected = "";
if ($formData->{'ClassID'} ne "" && $formData->{'ClassID'} eq $classID) {
if ($formData->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$classID.'" '.$selected.'>'.$trafficClasses->{$classID}.'</option>';
$trafficClassStr .= '<option value="'.encode_entities($trafficClassID).'" '.$selected.'>'.
encode_entities($trafficClass->{'Name'}).'</option>';
}
# Generate expires modifiers list
......@@ -1609,8 +1697,13 @@ EOF
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.$expiresModifiers->{$expireModifier}.
'</option>';
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# If we have IPNATInbound set, we need to set it to checked
if (defined($formData->{'IPNATInbound'}) && $formData->{'IPNATInbound'} ne "") {
$formData->{'IPNATInbound'} = "checked";
}
# Blank expires if its 0
......@@ -1649,6 +1742,16 @@ EOF
</div>
</div>
</div>
<div class="form-group">
<label for="IPNATAddress" class="col-md-2 control-label">NAT Address</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="IPNATAddress" type="text" placeholder="NAT Address" class="form-control"
value="$formData->{'IPNATAddress'}" />
<input name="IPNATInbound" type="checkbox" $formData->{'IPNATInbound'} /> NAT Inbound
</div>
</div>
</div>
<div class="form-group">
<label for="InterfaceGroupID" class="col-md-2 control-label">Interface Group</label>
<div class="row">
......@@ -1670,10 +1773,10 @@ EOF
</div>
</div>
<div class="form-group">
<label for="ClassID" class="col-md-2 control-label">Traffic Class</label>
<label for="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-2">
<select name="ClassID" class="form-control">
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
......@@ -1694,48 +1797,48 @@ EOF
</div>
</div>
<div class="form-group">
<label for="TrafficLimitTx" class="col-md-2 control-label">Download CIR</label>
<label for="TxCIR" class="col-md-2 control-label">Download CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitTx" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TrafficLimitTx'}" />
<input name="TxCIR" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitTxBurst" class="col-md-2 control-label">Download Limit</label>
<label for="TxLimit" class="col-md-2 control-label">Download Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitTxBurst" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TrafficLimitTxBurst'}" />
<input name="TxLimit" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitRx" class="col-md-2 control-label">Upload CIR</label>
<label for="RxCIR" class="col-md-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitRx" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'TrafficLimitRx'}" />
<input name="RxCIR" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'RxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitRxBurst" class="col-md-2 control-label">Upload Limit</label>
<label for="RxLimit" class="col-md-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="TrafficLimitRxBurst" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'TrafficLimitRxBurst'}" />
<input name="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -1761,20 +1864,21 @@ EOF
}
# Override list
sub override_list
# Pool override list
sub pool_override_list
{
my ($kernel,$globals,$client_session_id,$request) = @_;
my @overrides = getOverrides();
my @poolOverrides = getPoolOverrides();
# Build content
my $content = "";
# Header
$content .=<<EOF;
<legend>Override List</legend>
<legend>Pool Override List</legend>
<table class="table">
<thead>
<tr>
......@@ -1794,50 +1898,62 @@ sub override_list
<tbody>
EOF
# Body
foreach my $oid (@overrides) {
my $override;
# If we can't get the override, just skip it
if (!defined($override = getOverride($oid))) {
foreach my $poid (@poolOverrides) {
my $poolOverride;
# If we can't get the pool override, just skip it
if (!defined($poolOverride = getPoolOverride($poid))) {
next;
}
my $oidEscaped = uri_escape($override->{'ID'});
my $poolOverrideFriendlyNameEncoded = encode_entities(prettyUndef($poolOverride->{'FriendlyName'}));
my $poolOverridePoolNameEncoded = encode_entities(prettyUndef($poolOverride->{'PoolName'}));
my $poolOverrideUsernameEncoded = encode_entities(prettyUndef($poolOverride->{'Username'}));
my $poolOverrideIPAddressEncoded = encode_entities(prettyUndef($poolOverride->{'IPAddress'}));
my $poolOverrideIPNATAddressEncoded = encode_entities(prettyUndef($poolOverride->{'IPNATAddress'}));
my $poolOverrideExpiresStr = encode_entities(
($poolOverride->{'Expires'} > 0) ?
DateTime->from_epoch( epoch => $poolOverride->{'Expires'} )->iso8601() : '-never-'
);
my $friendlyNameEncoded = prettyUndef(encode_entities($override->{'FriendlyName'}));
my $usernameEncoded = prettyUndef(encode_entities($override->{'Username'}));
my $poolNameEncoded = prettyUndef(encode_entities($override->{'PoolName'}));
my $ipAddress = prettyUndef($override->{'IPAddress'});
my $expiresStr = ($override->{'Expires'} > 0) ?
DateTime->from_epoch( epoch => $override->{'Expires'} )->iso8601() : '-never-';
my $poolOverrideTrafficClassStr = "-undef-";
if (defined($poolOverride->{'TrafficClassID'})) {
my $trafficClass = getTrafficClass($poolOverride->{'TrafficClassID'});
$poolOverrideTrafficClassStr = encode_entities($trafficClass->{'Name'});
}
my $classStr = prettyUndef(getTrafficClassName($override->{'ClassID'}));
my $cirStr = sprintf('%s/%s',prettyUndef($override->{'TrafficLimitTx'}),prettyUndef($override->{'TrafficLimitRx'}));
my $limitStr = sprintf('%s/%s',prettyUndef($override->{'TrafficLimitTxBurst'}),
prettyUndef($override->{'TrafficLimitRxBurst'}));
my $poolOverrideCIRStr = encode_entities(
sprintf('%s/%s',prettyUndef($poolOverride->{'TxCIR'}),prettyUndef($poolOverride->{'RxCIR'}))
);
my $poolOverrideLimitStr = encode_entities(
sprintf('%s/%s',prettyUndef($poolOverride->{'TxLimit'}),prettyUndef($poolOverride->{'RxLimit'}))
);
my $urlPoolOverrideEdit = sprintf('/limits/pool-override-edit?poid=%s',encode_entities($poolOverride->{'ID'}));
my $urlPoolOverrideRemove = sprintf('/limits/pool-override-remove?poid=%s',encode_entities($poolOverride->{'ID'}));
$content .= <<EOF;
<tr>
<td></td>
<td>$friendlyNameEncoded</td>
<td>$poolNameEncoded</td>
<td>$usernameEncoded</td>
<td>$ipAddress</td>
<td>$expiresStr</td>
<td>$poolOverrideFriendlyNameEncoded</td>
<td>$poolOverridePoolNameEncoded</td>
<td>$poolOverrideUsernameEncoded</td>
<td>$poolOverrideIPAddressEncoded</td>
<td>$poolOverrideIPNATAddressEncoded</td>
<td>$poolOverrideExpiresStr</td>
<td><span class="glyphicon glyphicon-arrow-right" /></td>
<td>$classStr</td>
<td>$cirStr</td>
<td>$limitStr</td>
<td class="align-center">$poolOverrideTrafficClassStr</td>
<td class="align-center">$poolOverrideCIRStr</td>
<td class="align-center">$poolOverrideLimitStr</td>
<td>
<a href="/limits/override-edit?oid=$oidEscaped"><span class="glyphicon glyphicon-wrench" /></a>
<a href="/limits/override-remove?oid=$oidEscaped"><span class="glyphicon glyphicon-remove" /></a>
<a href="$urlPoolOverrideEdit"><span class="glyphicon glyphicon-wrench" /></a>
<a href="$urlPoolOverrideRemove"><span class="glyphicon glyphicon-remove" /></a>
</td>
</tr>
EOF
}
# No results
if (!@overrides) {
if (!@poolOverrides) {
$content .=<<EOF;
<tr class="info">
<td colspan="11"><p class="text-center">No Results</p></td>
......@@ -1856,8 +1972,9 @@ EOF
}
# Add/edit action
sub override_addedit
sub pool_override_addedit
{
my ($kernel,$globals,$client_session_id,$request) = @_;
......@@ -1871,17 +1988,17 @@ sub override_addedit
# Items for our form...
my @formElements = qw(
FriendlyName
PoolName Username IPAddress
ClassID
TrafficLimitTx TrafficLimitTxBurst
TrafficLimitRx TrafficLimitRxBurst
PoolName Username IPAddress IPNATAddress IPNATInbound
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
my @formElementCheckboxes = qw(
ClassID
TrafficLimitTx TrafficLimitTxBurst
TrafficLimitRx TrafficLimitRxBurst
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
);
# Expires modifier options
......@@ -1895,19 +2012,20 @@ sub override_addedit
# Title of the form, by default its an add form
my $formType = "Add";
my $formNoEdit = "";
my $checkboxNoEdit = "";
# Form data
my $formData;
# If we have a override, this is where its kept
my $override;
# If we have a pool override, this is where its kept
my $poolOverride;
# Grab query params
my $queryParams = parseURIQuery($request);
# If we have a override ID, pull in the override
if (defined($queryParams->{'oid'})) {
# Check if we can grab the override
if (!defined($override = getOverride($queryParams->{'oid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"limits/override-list");
# If we have a pool override ID, pull in the pool override
if (defined($queryParams->{'poid'})) {
# Check if we can grab the pool override
if (!defined($poolOverride = getPoolOverride($queryParams->{'poid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"limits/pool-override-list");
}
}
......@@ -1919,7 +2037,7 @@ sub override_addedit
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'limits/override-list');
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
# Transform form into form data
......@@ -1929,24 +2047,25 @@ sub override_addedit
# Set form type if its edit
if (defined($form->{'submit'}) && $form->{'submit'}->{'value'} eq "Edit") {
# Check override exists
if (!defined($override)) {
return (HTTP_TEMPORARY_REDIRECT,'limits/override-list');
# Check pool override exists
if (!defined($poolOverride)) {
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
$formData->{'ID'} = $override->{'ID'};
$formData->{'ID'} = $poolOverride->{'ID'};
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
}
# A GET would indicate that a override ID was passed normally
# A GET would indicate that a pool override ID was passed normally
} elsif ($request->method eq "GET") {
# We need a override
if (defined($override)) {
# Setup form data from override
# We need a pool override
if (defined($poolOverride)) {
# Setup form data from pool override
foreach my $key (@formElements) {
$formData->{$key} = $override->{$key};
$formData->{$key} = $poolOverride->{$key};
}
# Setup our checkboxes
foreach my $checkbox (@formElementCheckboxes) {
......@@ -1957,10 +2076,11 @@ sub override_addedit
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
# Woops ... no query string?
} elsif (keys %{$queryParams} > 0) {
return (HTTP_TEMPORARY_REDIRECT,'limits/override-list');
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
}
......@@ -1972,59 +2092,93 @@ sub override_addedit
push(@errors,"Friendly name must be specified");
}
# Make sure we have at least a pool name, username or IP address
my $poolName = isUsername($formData->{'PoolName'});
my $username = isUsername($formData->{'Username'});
my $ipAddress = isIP($formData->{'IPAddress'});
# Check the pool name is valid if it was specified
my $poolName;
if (defined($formData->{'PoolName'}) && $formData->{'PoolName'} ne "") {
if (!defined($poolName = isUsername($formData->{'PoolName'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Pool name is not valid");
}
}
# Next check the username
my $username;
if (defined($formData->{'Username'}) && $formData->{'Username'} ne "") {
if (!defined($username = isUsername($formData->{'Username'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Username is not valid");
}
}
# Then the IP
my $ipAddress;
if (defined($formData->{'IPAddress'}) && $formData->{'IPAddress'} ne "") {
if (!defined($ipAddress = isIPv46CIDR($formData->{'IPAddress'}))) {
push(@errors,"IP address is not valid");
}
}
# And NAT
my $ipNATAddress;
if (defined($formData->{'IPNATAddress'}) && $formData->{'IPNATAddress'} ne "") {
if (!defined($ipNATAddress = isIPv46($formData->{'IPNATAddress'}))) {
push(@errors,"NAT address is not valid");
}
}
my $ipNATInbound;
if (defined($formData->{'IPNATInbound'}) && $formData->{'IPNATInbound'} ne "") {
if (defined($ipNATAddress)) {
$ipNATInbound = "yes";
} else {
push(@errors,"Cannot NAT inbound traffic if no NAT address is set");
}
}
# Then confirm we have at least one of the above
if (!defined($poolName) && !defined($username) && !defined($ipAddress)) {
push(@errors,"A pool name and/or IP address and/or Username must be specified");
push(@errors,"At least a valid pool name, username or IP address must be specified to match");
}
# If the traffic class is ticked, process it
my $classID;
if (defined($formData->{'inputClassID.enabled'})) {
if (!defined($classID = isTrafficClassIDValid($formData->{'ClassID'}))) {
my $trafficClassID;
if (defined($formData->{'inputTrafficClassID.enabled'})) {
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
}
# Check traffic limits
my $trafficLimitTx;
if (defined($formData->{'inputTrafficLimitTx.enabled'})) {
if (!defined($trafficLimitTx = isNumber($formData->{'TrafficLimitTx'}))) {
my $txCIR;
if (defined($formData->{'inputTxCIR.enabled'})) {
if (!defined($txCIR = isNumber($formData->{'TxCIR'}))) {
push(@errors,"Download CIR is not valid");
}
}
my $trafficLimitTxBurst;
if (defined($formData->{'inputTrafficLimitTxBurst.enabled'})) {
if (!defined($trafficLimitTxBurst = isNumber($formData->{'TrafficLimitTxBurst'}))) {
my $txLimit;
if (defined($formData->{'inputTxLimit.enabled'})) {
if (!defined($txLimit = isNumber($formData->{'TxLimit'}))) {
push(@errors,"Download limit is not valid");
}
}
# Check TrafficLimitRx
my $trafficLimitRx;
if (defined($formData->{'inputTrafficLimitRx.enabled'})) {
if (!defined($trafficLimitRx = isNumber($formData->{'TrafficLimitRx'}))) {
# Check RxCIR
my $rxCIR;
if (defined($formData->{'inputRxCIR.enabled'})) {
if (!defined($rxCIR = isNumber($formData->{'RxCIR'}))) {
push(@errors,"Upload CIR is not valid");
}
}
my $trafficLimitRxBurst;
if (defined($formData->{'inputTrafficLimitRxBurst.enabled'})) {
if (!defined($trafficLimitRxBurst = isNumber($formData->{'TrafficLimitRxBurst'}))) {
my $rxLimit;
if (defined($formData->{'inputRxLimit.enabled'})) {
if (!defined($rxLimit = isNumber($formData->{'RxLimit'}))) {
push(@errors,"Upload limit is not valid");
}
}
# Check that we actually have something to override
# Check that we actually have something to pool override
if (
!defined($classID) &&
!defined($trafficLimitTx) && !defined($trafficLimitTxBurst) &&
!defined($trafficLimitRx) && !defined($trafficLimitRxBurst)
!defined($trafficClassID) &&
!defined($txCIR) && !defined($txLimit) &&
!defined($rxCIR) && !defined($rxLimit)
) {
push(@errors,"Something must be specified to override");
}
my $expires = 0;
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'}))) {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
......@@ -2055,20 +2209,21 @@ sub override_addedit
# Grab notes
my $notes = $formData->{'Notes'};
# If there are no errors we need to push this override
# If there are no errors we need to push this pool override
if (!@errors && $request->method eq "POST") {
# Build override
my $overrideData = {
# Build pool override
my $poolOverrideData = {
'FriendlyName' => $friendlyName,
'PoolName' => $poolName,
'Username' => $username,
'IPAddress' => $ipAddress,
# 'IPNATAddress' => $ipNATAddress,
# 'GroupID' => 1,
'ClassID' => $classID,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
};
......@@ -2076,28 +2231,30 @@ sub override_addedit
# Check if this is an add or edit
my $cEvent;
if ($formType eq "Add") {
$cEvent = "override_add";
$cEvent = "pool_override_add";
} else {
$overrideData->{'ID'} = $formData->{'ID'};
$cEvent = "override_change";
$poolOverrideData->{'ID'} = $formData->{'ID'};
$cEvent = "pool_override_change";
}
$kernel->post("configmanager" => $cEvent => $overrideData);
$kernel->post("configmanager" => $cEvent => $poolOverrideData);
$logger->log(LOG_INFO,"[WEBSERVER/OVERRIDE/ADD] Pool: %s, User: %s, IP: %s, Group: %s, Class: %s, Limits: %s/%s, ".
$logger->log(LOG_INFO,"[WEBSERVER/POOL-OVERRIDE/ADD] Pool: %s, User: %s, IP: %s, NAT: %s (inbound: %s), Group: %s, Class: %s, Limits: %s/%s, ".
"Burst: %s/%s",
prettyUndef($poolName),
prettyUndef($username),
prettyUndef($ipAddress),
prettyUndef($ipNATAddress),
prettyUndef($ipNATInbound),
"",
prettyUndef($classID),
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
prettyUndef($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'limits/override-list');
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
}
......@@ -2115,28 +2272,31 @@ sub override_addedit
# Form header
$content .=<<EOF;
<legend>$formType Override</legend>
<legend>$formType Pool Override</legend>
<form role="form" method="post">
EOF
# Spit out errors if we have any
if (@errors > 0) {
foreach my $error (@errors) {
$content .= '<div class="alert alert-danger">'.$error.'</div>';
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
# Generate traffic class list
my $trafficClasses = getTrafficClasses();
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $classID (sort keys %{$trafficClasses}) {
foreach my $trafficClassID (@trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
# Process selections nicely
my $selected = "";
if ($formData->{'ClassID'} ne "" && $formData->{'ClassID'} eq $classID) {
if ($formData->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$classID.'" '.$selected.'>'.$trafficClasses->{$classID}.'</option>';
$trafficClassStr .= '<option value="'.$trafficClassID.'" '.$selected.'>'.encode_entities($trafficClass->{'Name'}).
'</option>';
}
# Generate expires modifiers list
......@@ -2152,8 +2312,8 @@ EOF
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.$expiresModifiers->{$expireModifier}.
'</option>';
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# Blank expires if its 0
......@@ -2204,13 +2364,24 @@ EOF
</div>
</div>
</div>
<div class="form-group">
<label for="IPNATAddress" class="col-md-2 control-label">NAT Address</label>
<div class="row">
<div class="col-md-4">
<input name="IPNATAddress" type="text" placeholder="- - - override not implemented - - -" class="form-control"
value="$formData->{'IPNATAddress'}" $formNoEdit />
<input name="IPNATInbound" type="checkbox" $formData->{'IPNATInbound'} $checkboxNoEdit /> NAT Inbound
</div>
</div>
</div>
<div class="form-group">
<label for="ClassID" class="col-md-2 control-label">Traffic Class</label>
<label for="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-3">
<input name="inputClassID.enabled" type="checkbox" $formData->{'inputClassID.enabled'}/> Override
<select name="ClassID" class="form-control">
<input name="inputTrafficClassID.enabled" type="checkbox" $formData->{'inputTrafficClassID.enabled'}/>
Override
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
......@@ -2218,14 +2389,14 @@ EOF
</div>
<div class="form-group">
<label for="TrafficLimitTx" class="col-md-2 control-label">Download CIR</label>
<label for="TxCIR" class="col-md-2 control-label">Download CIR</label>
<div class="row">
<div class="col-md-3">
<input name="inputTrafficLimitTx.enabled" type="checkbox" $formData->{'inputTrafficLimitTx.enabled'} />
<input name="inputTxCIR.enabled" type="checkbox" $formData->{'inputTxCIR.enabled'} />
Override
<div class="input-group">
<input name="TrafficLimitTx" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TrafficLimitTx'}" />
<input name="TxCIR" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TxCIR'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -2233,14 +2404,14 @@ EOF
</div>
<div class="form-group">
<label for="TrafficLimitTxBurst" class="col-md-2 control-label">Download Limit</label>
<label for="TxLimit" class="col-md-2 control-label">Download Limit</label>
<div class="row">
<div class="col-md-3">
<input name="inputTrafficLimitTxBurst.enabled" type="checkbox"
$formData->{'inputTrafficLimitTxBurst.enabled'}/> Override
<input name="inputTxLimit.enabled" type="checkbox"
$formData->{'inputTxLimit.enabled'}/> Override
<div class="input-group">
<input name="TrafficLimitTxBurst" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TrafficLimitTxBurst'}" />
<input name="TxLimit" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -2248,28 +2419,28 @@ EOF
</div>
<div class="form-group">
<label for="inputTrafficLimitRx" class="col-md-2 control-label">Upload CIR</label>
<label for="inputRxCIR" class="col-md-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-md-3">
<input name="inputTrafficLimitRx.enabled" type="checkbox"
$formData->{'inputTrafficLimitRx.enabled'}/> Override
<input name="inputRxCIR.enabled" type="checkbox"
$formData->{'inputRxCIR.enabled'}/> Override
<div class="input-group">
<input name="TrafficLimitRx" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'TrafficLimitRx'}" />
<input name="RxCIR" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'RxCIR'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficLimitRxBurst" class="col-md-2 control-label">Upload Limit</label>
<label for="RxLimit" class="col-md-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-md-3">
<input name="inputTrafficLimitRxBurst.enabled" type="checkbox"
$formData->{'inputTrafficLimitRxBurst.enabled'}/> Override
<input name="inputRxLimit.enabled" type="checkbox"
$formData->{'inputRxLimit.enabled'}/> Override
<div class="input-group">
<input name="TrafficLimitRxBurst" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'TrafficLimitRxBurst'}" />
<input name="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
......@@ -2310,8 +2481,9 @@ EOF
}
# Remove action
sub override_remove
sub pool_override_remove
{
my ($kernel,$globals,$client_session_id,$request) = @_;
......@@ -2322,26 +2494,26 @@ sub override_remove
# Pull in GET
my $queryParams = parseURIQuery($request);
# We need a key first of all...
if (!defined($queryParams->{'oid'})) {
if (!defined($queryParams->{'poid'})) {
$content = <<EOF;
<div class="alert alert-danger text-center">
No override oid in query string!
No pool override oid in query string!
</div>
EOF
goto END;
}
# Grab the override
my $override = getOverride($queryParams->{'oid'}->{'value'});
# Grab the pool override
my $poolOverride = getPoolOverride($queryParams->{'poid'}->{'value'});
# Make the oid safe for HTML
my $encodedID = encode_entities($queryParams->{'oid'}->{'value'});
my $encodedPoolOverrideID = encode_entities($queryParams->{'poid'}->{'value'});
# Make sure the oid was valid... we would have an override now if it was
if (!defined($override)) {
# Make sure the oid was valid... we would have an pool override now if it was
if (!defined($poolOverride)) {
$content = <<EOF;
<div class="alert alert-danger text-center">
Invalid override oid "$encodedID"!
Invalid pool override oid "$encodedPoolOverrideID"!
</div>
EOF
goto END;
......@@ -2354,19 +2526,19 @@ EOF
# Check if its a success
if ($form->{'confirm'}->{'value'} eq "Yes") {
# Post the removal
$kernel->post("configmanager" => "override_remove" => $override->{'ID'});
$kernel->post("configmanager" => "pool_override_remove" => $poolOverride->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,'limits/override-list');
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
# Make the friendly name HTML safe
my $encodedFriendlyName = encode_entities($override->{'FriendlyName'});
my $encodedPoolOverrideFriendlyName = encode_entities($poolOverride->{'FriendlyName'});
# Build our confirmation dialog
$content .= <<EOF;
<div class="alert alert-danger">
Are you very sure you wish to remove override "$encodedFriendlyName"?
Are you very sure you wish to remove pool override "$encodedPoolOverrideFriendlyName"?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
......
opentrafficshaper/plugins/webserver/pages/static.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: index page
# Copyright (C) 2007-2014, AllWorldIT
# Copyright (C) 2007-2023, 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
......@@ -41,6 +41,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
sub _catchall
{
my ($kernel,$globals,$client_session_id,$request) = @_;
......@@ -76,7 +77,7 @@ sub _catchall
}
# Stat file first of all
my $stat = stat($filename);
my $stat = stat($filename);
if (!$stat) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to stat '%s': %s",$resource,$!);
return;
......@@ -107,7 +108,7 @@ sub _catchall
$response->header('Last-Modified', HTTP::Date::time2str($stat->mtime));
# Open file handle
if (!open(FH, "< $filename")) {
if (!open(FH, "< $filename")) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to open '%s': %s",$resource,$!);
}
# Set to binary mode
......@@ -124,8 +125,10 @@ sub _catchall
# Set content
$response->content($buffer);
return $response;
return $response;
}
1;
# vim: ts=4