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 10075 additions and 2978 deletions
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
[system]
# Log level:
# Log level
# 0 - Errors only
# 1 - Warnings and errors
# 2 - Notices, warnings, errors
# 3 - Info, notices, warnings, errors
# 4 - Debugging
#log_level=2
# 4 - Debugging
#
# default:
# log_level=2
# Log file to write log messages to
#
# default:
# log_file=/var/log/opentrafficshaper/opentrafficshaper.log
# Log file:
# Filename to write log messages to
# Defaults to /var/log/opentrafficshaper/opentrafficshaper.log
#log_file=/var/log/opentrafficshaper/opentrafficshaper.log
# PID file to write our PID to
#
# default:
# pid_file=/run/opentrafficshaper/opentrafficshaper.pid
# PID file:
# Filename to write our PID to
# Defaults to /var/run/opentrafficshaper/opentrafficshaper.pid
#pid_file=/var/run/opentrafficshaper/opentrafficshaper.pid
# State file, this file is used to store persistent information
#
# default:
# statefile=/var/lib/opentrafficshaper/configmanager.state
# STATE file:
# This is the file used to store persistent information
#statefile=/var/lib/opentrafficshaper/configmanager.state
#
# Plugins
#
[plugins]
# Names of plugins to load, one per line
# NOTE: The ordering is very important
# Radius support
load=radius
load=webserver
load=tc
# Statistics
# Must load before webserver if you want graphs
load=statistics
load=tcstats
# Web interface
load=webserver
# Statistics live streaming snapin
# Must load after webserver
load=webserver/snapins/websockets/statistics
# Traffic shaper
load=tc
# Traffic shaper interface to statistics
# Must load after statistics
# Must load after tc
load=tcstats
#
# General shaping settings
#
[shaping]
# Group 1 is by default the "Default" group
# User group, this is the list of groups users can belong to
#
# The format of this option is:
# <ID>:<DESCRIPTION>
#
# * NOT IMPLEMENTED YET *
#
# default:
# none
group=1:Default
# Traffic classes
# ID's and short description of traffic classes to Setup. Traffic is
# priortized as the lowest number getting the highest priority
# Traffic classes ID's and short description of traffic classes to Setup. Traffic is priortized as the lowest number getting the
# highest priority
#
# The format of this option is:
# <ID>:<DESCRIPTION>
#
# default:
# none
class=1:High Priority
class=2:Platinum
class=3:Gold
......@@ -57,49 +90,158 @@ class=5:Bronze
class=6:Best Effort
# Default pool
# For traffic not classified, we can send it to a rate-limited pool
# Deafults to "no"
#use_default_pool=no
# Default pool for traffic not classified, we can send it to a specific traffic class. This is a pool ID.
#
# default:
# default_pool=no
# Interface groups that a pool is associated with
#
# The format of this option is:
# <TXIFACE>,<RXIFACE>:<DESCRIPTION>
#
# The txiface is always the interface the client traffic is transmitted on (downloaded)
# The rxiface is always the interface the client traffic is received on (uploaded)
#
# default:
# interface_group=eth1,eth0:Default
interface_group=eth1,eth0:LAN-side
#
# Interface setup
#
# Each interface comprises of a name, rate and a list of class rates for each class defined above. Each interface used in the
# interface_groups above must be defined below.
#
[shaping.interface eth0]
# This is the friendly name used when displaying this interface
name=WAN interface
# The rate is specified in Kbps
rate=100000
# Class rate specification
#
# format:
# <CLASSID>:<CIR>[/<LIMIT>]
#
# The CIR and Limit are specified in Kbps or percentage
# If Limit is not specified it defaults to CIR
# if the entire class definition is omitted, defaults to rate of interface
#
# default:
# --interface limit for each class--
class_rate=1:10000
class_rate=2:5%/5%
class_rate=3:5%
class_rate=4:5000/10000
class_rate=5:5%
class_rate=6:5%
[shaping.interface eth1]
name=LAN Interface
rate=100000
class_rate=1:70000
class_rate=2:5%/5%
class_rate=3:5%
class_rate=4:3000/5000
class_rate=5:5%
#
# Radius plugin
#
[plugin.radius]
# Path of the radius dictionary files
#
# default:
# none
dictionary_path=/etc/opentrafficshaper
# Dictionaries we need to load for radius functionality
# Dictionaries we need to load for radius attributes we use, these are paths relative to dicitonary_path=
#
# default:
# none
dictionary=dicts/dictionary
dictionary=dicts/dictionary.allworldit
# Expire traffic control entries from radius in this period of time if not updated
# Default: 86400 (1 day)
#expiry_period=86400
# Expire traffic control entries from radius in this period of time if not updated, this is in seconds
#
# default:
# expiry_period=86400
# Pool name transform to apply to the username. We apply a regex to the username and grab the first returned group, this group is
# then used as the pool name instead of the full username.
#
#
# Example: To use user@POOL, try something like this...
# username_to_pool_transform=^[^@]+@(.*)
#
# Example: To use user.POOL@realm, try something like this...
# username_to_pool_transform=^[^\.]+\.([^@]+)
#
# default:
# none
# Interface group to use for users which don't have the attribute set
#
# default:
# default_interface_group=1
# Match priority to use for users which don't have the attribute set
#
# default:
# default_match_priority=2
# Traffic class to use for users which don't have the attribute set
#
# default:
# default_traffic_class=2
# NOT IMPLEMENTED: Default group to use for users which don't have the attribute set
#
# default:
# default_group=1
#
# TC Plugin
#
[plugin.tc]
# Interface used for transmission of traffic to client
txiface=eth1
# Interface used for the receiving of traffic for client
rxiface=eth0
# Rates of both interfaces
# This is in Mbit/s!!
# Defaults to 100 each
txiface_rate=100
rxiface_rate=100
# Protocol to filter on, 99% of the time it will be "ip"
# If however you're filtering VLAN Q-in-Q traffic, set this to 0x88a8
#protocol=ip
# IP Header offset
# If the kernel offsets your IP packet with octets you need to specify the value here
# this most commonly happens when you shaping vlan traffic (as per above one would maybe
# set this value to 4)
#iphdr_offset=0
# Protocol to filter on, 99% of the time it will be "ip". If however you're filtering VLAN Q-in-Q traffic, set this to 0x88a8
#
# default:
# protocol=ip
# IP Header offset, if the kernel offsets your IP packet with octets you need to specify the value here this most commonly happens
# when you shaping vlan traffic (as per above one would maybe set this value to 4)
#
# default:
# iphdr_offset=0
#
# Statistics Plugin
#
[plugin.statistics]
# Database credentials used for stats recording
#
# example:
# db_dsn=DBI:mysql:dbname=ots
# db_username=
# db_password=
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
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
##
# Code originally based on POE::Filter::HTTPD
......@@ -15,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;
......@@ -23,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.000';
$VERSION = '2.000';
@ISA = qw(POE::Filter);
......@@ -52,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);
......@@ -71,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) = @_;
......@@ -84,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;
......@@ -96,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();
......@@ -109,7 +122,7 @@ sub get_one
# Function to push data to the socket
sub put
sub put
{
my ($self, $responses) = @_;
my @results;
......@@ -124,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'))
) {
......@@ -132,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);
}
......@@ -141,18 +154,22 @@ sub put
push(@results,$self->_build_raw_response($response));
}
# Handle WebSocket data
} elsif ($self->{'state'} == ST_WEBSOCKET_STREAM) {
# Compile our list of results
foreach my $response (@{$responses}) {
# If we don't have a websocket write state, create one
if (!$self->{'state_websocket_write'}) {
$self->{'state_websocket_write'} = new POE::Filter::HybridHTTP::WebSocketFrame();
# If we don't have a websocket state, create one
if (!$self->{'websocket_state'}) {
$self->{'websocket_state'} = new opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame();
}
$self->{'state_websocket_write'}->append($response);
push(@results,$self->{'state_websocket_write'}->to_bytes());
# Don't mask replies from server to client RFC6455 secion 5.1.
$self->{'websocket_state'}->masked(0);
# Consume the response with websockets...
$self->{'websocket_state'}->append($response);
# Spit out bytes...
my $payload = $self->{'websocket_state'}->to_bytes();
push(@results,$payload);
}
}
......@@ -174,8 +191,7 @@ sub _reset
# Reset our filter state
$self->{'buffer'} = '';
$self->{'state'} = ST_HTTP_HEADERS;
$self->{'state_websocket_read'} = undef;
$self->{'state_websocket_write'} = undef;
$self->{'websocket_state'} = undef;
$self->{'last_request'} = $self->{'request'};
$self->{'request'} = undef; # We want the last request always
$self->{'content_len'} = 0;
......@@ -185,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;
......@@ -214,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.
......@@ -258,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;
......@@ -272,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
......@@ -306,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.
......@@ -328,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();
}
......@@ -387,16 +403,16 @@ sub _get_one_websocket_record
# If we don't have a websocket state, create one
if (!$self->{'state_websocket_read'}) {
$self->{'state_websocket_read'} = new POE::Filter::HybridHTTP::WebSocketFrame();
if (!$self->{'websocket_state'}) {
$self->{'websocket_state'} = new opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame();
}
$self->{'state_websocket_read'}->append($self->{'buffer'});
$self->{'websocket_state'}->append($self->{'buffer'});
# Blank our buffer
$self->{'buffer'} = '';
# Loop with records and push onto result set
my @results;
while (my $item = $self->{'state_websocket_read'}->next()) {
while (my $item = $self->{'websocket_state'}->next()) {
push(@results,$item);
}
......@@ -460,10 +476,11 @@ sub _build_raw_response
if (!defined($response->header("Server"))) {
$response->push_header("Server","POE Hybrid HTTP Server v$VERSION");
}
# Set our content Length
if (my $length = length($response->content)) {
$response->push_header("Content-Length",$length);
}
# 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->header("Content-Length" => length($response->content));
# Setup our output
my $output = sprintf("%s %s",$self->{'protocol'},$response->status_line);
......@@ -477,3 +494,4 @@ sub _build_raw_response
1;
# vim: ts=4
opentrafficshaper/POE/Filter/HybridHTTP/WebSocketFrame.pm
View file @ efc9ebe1
# POE::Filter::HybridHTTP::WebSocketFrame - Copyright 2013, 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
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
##
# Code originally based on Protocol::WebSocket::Frame
......@@ -20,7 +33,9 @@
# the same terms as Perl 5.10.
##
package POE::Filter::HybridHTTP::WebSocketFrame;
package opentrafficshaper::POE::Filter::HybridHTTP::WebSocketFrame;
use bytes;
use strict;
use warnings;
......@@ -95,7 +110,7 @@ sub next {
return Encode::decode('UTF-8', $bytes);
}
return;
return;
}
sub fin { @_ > 1 ? $_[0]->{fin} = $_[1] : $_[0]->{fin} }
......@@ -133,7 +148,7 @@ sub next_bytes {
$offset += 1; # FIN,RSV[1-3],OPCODE
# Grab payload length
my $payload_len = unpack 'C', substr($self->{'buffer'}, $offset, 1);
my $payload_len = unpack('C',substr($self->{'buffer'}, $offset, 1));
# Check if the payload is masked, if it is flag it internally
my $masked = ($payload_len & 0b10000000) >> 7;
......@@ -147,7 +162,7 @@ sub next_bytes {
return;
}
# Unpack the payload_len into its actual value & bump the offset
$payload_len = unpack 'n', substr($self->{'buffer'}, $offset, 2);
$payload_len = unpack('n',substr($self->{'buffer'},$offset,2));
$offset += 2;
} elsif ($payload_len > 126) {
......@@ -174,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;
}
......@@ -245,6 +260,7 @@ sub next_bytes {
return;
}
sub to_bytes {
my $self = shift;
......@@ -259,38 +275,40 @@ sub to_bytes {
$opcode = $self->opcode || 1;
}
$string .= pack 'C', ($opcode + 128);
# Set FIN + black RSV + set OPCODE in the first 8 bites
$string .= pack('C',($opcode | 0b10000000) & 0b10001111);
my $payload_len = length($self->{'buffer'});
if ($payload_len <= 125) {
# Flip masked bit if we're masked
$payload_len |= 0b10000000 if $self->masked;
$string .= pack 'C', $payload_len;
# Encode the payload length and add to string
$string .= pack('C',$payload_len);
}
elsif ($payload_len <= 0xffff) {
$string .= pack 'C', 126 + ($self->masked ? 128 : 0);
$string .= pack 'n', $payload_len;
my $bits = 0b01111110;
$bits |= 0b10000000 if $self->masked;
$string .= pack('C',$bits);
$string .= pack('n',$payload_len);
}
else {
$string .= pack 'C', 127 + ($self->masked ? 128 : 0);
my $bits = 0b01111111;
$bits |= 0b10000000 if $self->masked;
$string .= pack('C',$bits);
# Shifting by an amount >= to the system wordsize is undefined
$string .= pack 'N', $Config{'ivsize'} <= 4 ? 0 : $payload_len >> 32;
$string .= pack 'N', ($payload_len & 0xffffffff);
$string .= pack('N',$Config{'ivsize'} <= 4 ? 0 : $payload_len >> 32);
$string .= pack('N',($payload_len & 0xffffffff));
}
if ($self->masked) {
my $mask = $self->{mask} || ( MATH_RANDOM_SECURE ? Math::Random::Secure::irand(MAX_RAND_INT) : int(rand(MAX_RAND_INT)) );
my $mask = $self->{mask}
|| (
MATH_RANDOM_SECURE
? Math::Random::Secure::irand(MAX_RAND_INT)
: int(rand(MAX_RAND_INT))
);
$mask = pack 'N', $mask;
$mask = pack('N',$mask);
$string .= $mask;
$string .= $self->_mask($self->{'buffer'}, $mask);
$string .= $self->_mask($self->{'buffer'},$mask);
}
else {
$string .= $self->{'buffer'};
......@@ -302,6 +320,7 @@ sub to_bytes {
return $string;
}
sub _mask {
my $self = shift;
my ($payload, $mask) = @_;
......@@ -314,3 +333,4 @@ sub _mask {
}
1;
# vim: ts=4
opentrafficshaper/POE/Filter/TCStatistics.pm 0 → 100644
View file @ efc9ebe1
# OpenTrafficShaper POE::Filter::TCStatistics TC stats filter
# OpenTrafficShaper webserver module: limits page
# 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
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
##
# Code originally based on POE::Filter::HTTPD
##
# Filter::HTTPD Copyright 1998 Artur Bergman <artur@vogon.se>.
# Thanks go to Gisle Aas for his excellent HTTP::Daemon. Some of the
# get code was copied out if, unfortunately HTTP::Daemon is not easily
# subclassed for POE because of the blocking nature.
# 2001-07-27 RCC: This filter will not support the newer get_one()
# interface. It gets single things by default, and it does not
# support filter switching. If someone absolutely needs to switch to
# and from HTTPD filters, they should submit their request as a patch.
##
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 = '3.000';
@ISA = qw(POE::Filter);
# Class instantiation
sub new
{
my $class = shift;
# These are our internal properties
my $self = { };
# Build our class
bless($self, $class);
# And initialize
$self->_reset();
return $self;
}
# 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
{
my ($self, $stream) = @_;
# Join all the blocks of data and add to our buffer
$self->{'buffer'} .= join('',@{$stream});
return $self;
}
# This is called to see if we can grab records/items
sub get_one
{
my $self = shift;
my @results = ();
# 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;
}
# 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
{
my ($self, $data) = @_;
my @results = [ $data ];
return \@results;
}
#
# Internal functions
#
# Prepare for next request
sub _reset
{
my $self = shift;
# Reset our filter state
$self->{'buffer'} = '';
}
# Get rate...
sub _getKNumber
{
my $str = shift;
my ($num,$multiplier) = ($str =~ /([0-9]+)([KMG])?/);
# We only work in Kbit
if (!defined($multiplier)) {
$num /= 1000;
} elsif ($multiplier eq "K") {
# noop
} elsif ($multiplier eq "M") {
$num *= 1000;
} elsif ($multiplier eq "G") {
$num *= 1000000;
}
return int($num);
}
1;
opentrafficshaper/constants.pm
View file @ efc9ebe1
# OpenTrafficShaper constants package
# Copyright (C) 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -25,16 +25,39 @@ require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
CFGM_NEW
CFGM_OFFLINE
CFGM_ONLINE
CFGM_CHANGED
SHAPER_NOTLIVE
SHAPER_PENDING
SHAPER_LIVE
SHAPER_CONFLICT
);
# CFGM_NEW - New
# CFGM_OFFLINE - Offline
# CFGM_ONLINE - Online
# CFGM_CHANGED - Changed
use constant {
CFGM_OFFLINE => 1,
CFGM_CHANGED => 2,
CFGM_ONLINE => 3,
CFGM_NEW => 4,
};
# SHAPER_NOTLIVE - Nothing is going on yet, something should happen
# SHAPER_PENDING - Waiting on shaper to do a change
# SHAPER_LIVE - Shaper is up to date with our config
# SHAPER_CONFLICT - Item is in conflict
use constant {
SHAPER_NOTLIVE => 0,
SHAPER_PENDING => 1,
SHAPER_LIVE => 2,
SHAPER_NOTLIVE => 1,
SHAPER_PENDING => 2,
SHAPER_LIVE => 4,
SHAPER_CONFLICT => 8,
};
......
opentrafficshaper/logger.pm
View file @ efc9ebe1
# Logging functionality
# 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -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
{
......@@ -81,9 +84,9 @@ sub log
# Parse message nicely
if ($msg =~ /^(\[[^\]]+\]) (.*)/s) {
$msg = "$1 $logtxt: $2";
$msg = sprintf("%s %s: %s",$1,$logtxt,$2);
} else {
$msg = "[UNKNOWN] $logtxt: $msg";
$msg = sprintf("[UNKNOWN] %s: %s",$logtxt,$msg);
}
# If we have args, this is more than likely a format string & args
......@@ -93,10 +96,12 @@ sub log
# Check if we need to log this
if ($level <= $self->{'level'}) {
local *FH = $self->{'handle'};
print(FH "[".strftime('%F %T',localtime)." - $$] $msg\n");
printf(FH "[%s - %s] %s\n",strftime('%F %T',localtime),$$,$msg);
}
}
# 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-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
# the Free Software Foundation, either version 3 of the License, or
......@@ -28,7 +28,7 @@ require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
plugin_is_loaded
isPluginLoaded
);
@EXPORT_OK = qw(
plugin_register
......@@ -38,8 +38,9 @@ our (@ISA,@EXPORT,@EXPORT_OK);
my $globals;
# Check if a plugin is loaded
sub plugin_is_loaded
sub isPluginLoaded
{
my $pluginName = shift;
......@@ -48,6 +49,7 @@ sub plugin_is_loaded
}
# Function to register a plugin
sub plugin_register
{
......@@ -65,9 +67,9 @@ sub plugin_register
# System plugins are in the top dir
my $package;
if ($systemPlugin) {
$package = "opentrafficshaper::plugins::${packageName}";
$package = sprintf("opentrafficshaper::plugins::%s",$packageName);
} else {
$package = "opentrafficshaper::plugins::${packageName}::${pluginName}";
$package = sprintf("opentrafficshaper::plugins::%s::%s",$packageName,$pluginName);
}
# Core configuration manager
......@@ -79,17 +81,20 @@ sub plugin_register
if ($@ || (defined($res) && $res != 0)) {
# Check if the error is critical or not
if ($systemPlugin) {
$logger->log(LOG_ERR,"[PLUGINS] Error loading plugin '$pluginName', things WILL BREAK! ($@)");
$logger->log(LOG_ERR,"[PLUGINS] Error loading plugin '%s', things WILL BREAK! (%s)",$pluginName,$@);
exit;
} else {
$logger->log(LOG_WARN,"[PLUGINS] Error loading plugin '$pluginName' ($@)");
$logger->log(LOG_WARN,"[PLUGINS] Error loading plugin '%s' (%s)",$pluginName,$@);
exit;
}
} else {
$logger->log(LOG_DEBUG,"[PLUGINS] Plugin '$pluginName' loaded.");
$logger->log(LOG_DEBUG,"[PLUGINS] Plugin '%s' loaded.",$pluginName);
}
}
}
# Setup our main config ref
sub init
{
......@@ -99,11 +104,11 @@ sub init
}
#
# Internal functions
#
# Register plugin info
sub _plugin_register {
my ($pluginName,$pluginInfo) = @_;
......@@ -113,7 +118,7 @@ sub _plugin_register {
# If no info, return
if (!defined($pluginInfo)) {
$logger->log(LOG_WARN,"[MAIN] Plugin info not found for plugin => $pluginName");
$logger->log(LOG_WARN,"[MAIN] Plugin info not found for plugin => %s",$pluginName);
return -1;
}
......@@ -122,10 +127,14 @@ sub _plugin_register {
# Loop with plugin requires
foreach my $require (@{$pluginInfo->{'Requires'}}) {
# Check if plugin is loaded
my $found = plugin_is_loaded($require);
my $found = isPluginLoaded($require);
# If still not found ERR out
if (!$found) {
$logger->log(LOG_ERR,"[MAIN] Dependency '$require' for plugin '$pluginName' NOT MET. Make sure its loaded before '$pluginName'");
$logger->log(LOG_ERR,"[MAIN] Dependency '%s' for plugin '%s' NOT MET. Make sure its loaded before '%s'",
$require,
$pluginName,
$pluginName
);
last;
}
}
......@@ -139,11 +148,14 @@ sub _plugin_register {
$pluginInfo->{'Plugin'} = $pluginName;
$globals->{'plugins'}->{$pluginName} = $pluginInfo;
} else {
$logger->log(LOG_ERR,"[MAIN] Intialization of plugin failed => $pluginName");
$logger->log(LOG_ERR,"[MAIN] Intialization of plugin failed => %s",$pluginName);
}
}
return 0;
}
1;
# vim: ts=4
opentrafficshaper/plugins/configmanager.pm
View file @ efc9ebe1
# OpenTrafficShaper configuration manager
# 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
......@@ -21,12 +21,28 @@ package opentrafficshaper::plugins::configmanager;
use strict;
use warnings;
use POE;
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
);
......@@ -37,89 +53,250 @@ our (@ISA,@EXPORT,@EXPORT_OK);
@EXPORT = qw(
);
@EXPORT_OK = qw(
getLimit
getLimits
getLimitUsername
setLimitAttribute
getLimitAttribute
getOverride
getOverrides
getShaperState
setShaperState
getTrafficClasses
getTrafficClassName
isTrafficClassValid
createGroup
isGroupIDValid
createTrafficClass
getTrafficClass
getTrafficClasses
getInterfaceTrafficClass
getAllTrafficClasses
isTrafficClassIDValid
isInterfaceIDValid
createInterface
createInterfaceClass
createInterfaceGroup
changeInterfaceTrafficClass
getEffectiveInterfaceTrafficClass2
isInterfaceTrafficClassValid
setInterfaceTrafficClassShaperState
unsetInterfaceTrafficClassShaperState
createLimit
getPoolOverride
getPoolOverrides
createPool
removePool
changePool
getPools
getPool
getPoolByName
getPoolTxInterface
getPoolRxInterface
getPoolTrafficClassID
setPoolAttribute
getPoolAttribute
removePoolAttribute
getPoolShaperState
setPoolShaperState
unsetPoolShaperState
isPoolIDValid
isPoolOverridden
isPoolReady
getEffectivePool
createPoolMember
removePoolMember
changePoolMember
getPoolMembers
getPoolMember
getPoolMemberByUsernameIP
getAllPoolMembersByInterfaceGroupIP
getPoolMemberMatchPriority
setPoolMemberShaperState
unsetPoolMemberShaperState
getPoolMemberShaperState
getPoolMemberMatchPriority
setPoolMemberAttribute
getPoolMemberAttribute
removePoolMemberAttribute
isPoolMemberReady
getTrafficClassPriority
getTrafficDirection
getInterface
getInterfaces
getInterfaceDefaultPool
getInterfaceLimit
getInterfaceGroup
getInterfaceGroups
isInterfaceGroupIDValid
getMatchPriorities
isMatchPriorityIDValid
);
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,
# Intervals for periodic actions
CLEANUP_INTERVAL => 300,
STATE_SYNC_INTERVAL => 300,
};
# Mandatory config attributes
sub LIMIT_REQUIRED_ATTRIBUTES {
# Mandatory pool attributes
sub POOL_REQUIRED_ATTRIBUTES {
qw(
Username IP
GroupID ClassID
TrafficLimitTx TrafficLimitRx
Expires Status
Name
InterfaceGroupID
TrafficClassID TxCIR RxCIR
Source
)
}
# Limit Changeset attributes - things that can be changed on the fly in the shaper
sub LIMIT_CHANGESET_ATTRIBUTES {
# Pool attributes that can be changed
sub POOL_CHANGE_ATTRIBUTES {
qw(
GroupID ClassID
TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
FriendlyName
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
}
# Persistent attributes supported
sub LIMIT_PERSISTENT_ATTRIBUTES {
# Pool persistent attributes
sub POOL_PERSISTENT_ATTRIBUTES {
qw(
Username IP
GroupID ClassID
TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst TrafficPriority
FriendlyName Notes
Expires Created
ID
Name
FriendlyName
InterfaceGroupID
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 {
qw(
Username IPAddress
MatchPriorityID
PoolID
GroupID
Source
)
}
# Pool member attributes that can be changed
sub POOLMEMBER_CHANGE_ATTRIBUTES {
qw(
FriendlyName
Expires
Notes
)
}
# Pool member persistent attributes
sub POOLMEMBER_PERSISTENT_ATTRIBUTES {
qw(
FriendlyName
Username IPAddress
IPNATAddress
IPNATInbound
MatchPriorityID
PoolID
GroupID
Source
Expires
Notes
)
}
# Mandatory limit attributes
sub LIMIT_REQUIRED_ATTRIBUTES {
qw(
Username IPAddress
InterfaceGroupID MatchPriorityID
GroupID
TrafficClassID TxCIR RxCIR
Source
)
}
# Mandatory override attribute, one is required
sub OVERRIDE_REQUIRED_ATTRIBUTES {
# Pool override match attributes, one is required
sub POOL_OVERRIDE_MATCH_ATTRIBUTES {
qw(
Username IP
PoolName Username IPAddress
GroupID
)
}
# Override changeset attributes
sub OVERRIDE_CHANGESET_ATTRIBUTES {
# Pool override attributes
sub POOL_OVERRIDE_ATTRIBUTES {
qw(
FriendlyName
PoolName Username IPAddress GroupID
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
}
# Pool override attributes that can be changed
sub POOL_OVERRIDE_CHANGE_ATTRIBUTES {
qw(
FriendlyName
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Expires
Notes
)
}
# 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(
Key
Username IP
GroupID ClassID
TrafficLimitTx TrafficLimitRx TrafficLimitTxBurst TrafficLimitRxBurst
FriendlyName Notes
FriendlyName
PoolName Username IPAddress GroupID
TrafficClassID TxCIR RxCIR TxLimit RxLimit
Notes
Expires Created
Source
LastUpdate
......@@ -127,6 +304,8 @@ sub OVERRIDE_PERSISTENT_ATTRIBUTES {
}
# Plugin info
our $pluginInfo = {
Name => "Config Manager",
......@@ -137,122 +316,235 @@ our $pluginInfo = {
};
# Copy of system globals
# This modules globals
my $globals;
# System logger
my $logger;
# Configuration for this plugin
my $config = {
# Use default pool for unclassified traffic
'use_default_pool' => 0,
'default_pool_txrate' => undef,
'default_pool_rxrate' => undef,
'default_pool_priority' => 10,
# Traffic groups
'groups' => {
1 => 'Default'
},
# Traffic classes
'classes' => {
1 => 'Default'
our $config = {
# Match priorities
'match_priorities' => {
1 => 'First',
2 => 'Default',
3 => 'Fallthrough'
},
# State file
'statefile' => '/var/lib/opentrafficshaper/configmanager.state',
};
# Pending changes
my $changeQueue = { };
#
# GROUPS - pool members are linked to groups
#
# Attributes:
# * ID
# * Name
#
# $globals->{'Groups'}
#
# CLASSES
#
# Attributes:
# * ID
# * Name
#
# $globals->{'TrafficClasses'}
#
# INTERFACES
#
# Attributes:
# * ID
# * Name
# * Interface
# * Limit
#
# $globals->{'Interfaces'}
#
# POOLS
#
# Parameters:
# * ID
# * FriendlyName
# - Used for display purposes
# * Name
# - Unix timestamp when this entry expires, 0 if never
# * TrafficClassID
# - Traffic class ID
# * InterfaceGroupID
# - 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
# * Source
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'Pools'}
# $globals->{'PoolNameMap'}
# $globals->{'PoolIDCounter'}
#
# LIMITS
# POOL MEMBERS
#
# Supoprted user attributes:
# * ID
# * PoolID
# - Pool ID
# * Username
# - Users username
# * IP
# - Users IP
# - Users username
# * IPAddress
# - Users IP address
# * GroupID
# - Group ID
# * 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
# - Group ID
# * MatchPriorityID
# - 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 $limits = { };
my $limitIPMap = { };
my $limitIDMap = { };
my $limitIDCounter = 1;
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'PoolMembers'}
# $globals->{'PoolMemberIDCounter'}
# $globals->{'PoolMemberMap'}
#
# OVERRIDES
# POOL OVERRIDES
#
# Selection criteria:
# * PoolName
# - Pool name
# * Username
# - Users username
# * IP
# - Users IP
# - Users username
# * IPAddress
# - 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 = { };
# - This is the source of the limit, typically plugin.ModuleName
#
# $globals->{'PoolOverrides'}
# $globals->{'PoolOverrideIDCounter'}
#
# 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'} = { };
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] OpenTrafficShaper Config Manager v".VERSION." - Copyright (c) 2013, AllWorldIT");
$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($system->{'file.config'}->{'shaping'})) {
$gconfig = $system->{'file.config'}->{'shaping'};
}
# Split off groups to load
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading traffic groups...");
# Check if we loaded an array or just text
my @groups = ref($globals->{'file.config'}->{'shaping'}->{'group'}) eq "ARRAY" ? @{$globals->{'file.config'}->{'shaping'}->{'group'}} :
( $globals->{'file.config'}->{'shaping'}->{'group'} );
my @groups;
if (defined($gconfig->{'group'})) {
if (ref($gconfig->{'group'}) eq "ARRAY") {
@groups = @{$gconfig->{'group'}};
} else {
@groups = ( $gconfig->{'group'} );
}
} else {
@groups = ( "1:Default (auto)" );
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No groups, setting up defaults");
}
# Loop with groups
foreach my $group (@groups) {
# Skip comments
......@@ -260,101 +552,425 @@ sub plugin_init
# Split off group ID and group name
my ($groupID,$groupName) = split(/:/,$group);
if (!defined($groupID) || int($groupID) < 1) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load traffic group definition '$group': ID is invalid");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic group definition '%s' has invalid ID, ignoring",$group);
next;
}
if (!defined($groupName) || $groupName eq "") {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load traffic group definition '$group': Name is invalid");
$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 '$groupName' with ID $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] Loading traffic groups completed.");
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Traffic groups loaded");
# Split off traffic classes
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading traffic classes...");
# Check if we loaded an array or just text
my @classes = ref($globals->{'file.config'}->{'shaping'}->{'class'}) eq "ARRAY" ? @{$globals->{'file.config'}->{'shaping'}->{'class'}} :
( $globals->{'file.config'}->{'shaping'}->{'class'} );
my @classes;
if (defined($gconfig->{'class'})) {
if (ref($gconfig->{'class'}) eq "ARRAY") {
@classes = @{$gconfig->{'class'}};
} else {
@classes = ( $gconfig->{'class'} );
}
} else {
@classes = ( "1:Default (auto)" );
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No classes, setting up defaults");
}
# Loop with classes
foreach my $class (@classes) {
# Skip comments
next if ($class =~ /^\s*#/);
# Split off class ID and class name
my ($classID,$className) = split(/:/,$class);
if (!defined($classID) || int($classID) < 1) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load traffic class definition '$class': ID is invalid");
my ($trafficClassID,$className) = split(/:/,$class);
if (!defined(isNumber($trafficClassID))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic class definition '%s' has invalid ID, ignoring",$class);
next;
}
if (!defined($className) || $className eq "") {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load traffic class definition '$class': Name is invalid");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Traffic class definition '%s' has invalid name, ignoring",$class);
next;
}
# Create class
$trafficClassID = createTrafficClass({
'ID' => $trafficClassID,
'Name' => $className
});
if (!defined($trafficClassID)) {
next;
}
$config->{'classes'}->{$classID} = $className;
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic class '$className' with ID $classID.");
$logger->log(LOG_INFO,"[CONFIGMANAGER] Loaded traffic class '%s' [%s]",$className,$trafficClassID);
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading traffic classes completed.");
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Traffic classes loaded");
# Check if we using a default pool or not
if (defined(my $dp = booleanize($globals->{'file.config'}->{'shaping'}->{'use_default_pool'}))) {
# If we are using the default pool, load the limits
if ($config->{'use_default_pool'} = $dp) {
# Pull in both config items
if (defined(my $txir = $globals->{'file.config'}->{'shaping'}->{'default_pool_txrate'})) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Set default_pool_txrate to '$txir'");
$config->{'default_pool_txrate'} = isNumber($txir);
# Load interfaces
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Loading interfaces...");
my @interfaces;
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'");
}
# Loop with interface
foreach my $interface (@interfaces) {
# This is the interface config to make things easier for us
my $iconfig = { };
# Check if its defined
if (defined($system->{'file.config'}->{'shaping.interface'}) &&
defined($system->{'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 "") {
$interfaceName = $iconfig->{'name'};
} else {
$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 limit is valid
if (defined(my $rate = isNumber($iconfig->{'rate'}))) {
$interfaceLimit = $rate;
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] There is a problem with default_pool_txrate, config item use_default_pool disabled");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' has invalid 'rate' attribute, using 100000 instead",
$interface
);
}
if (defined(my $rxir = $globals->{'file.config'}->{'shaping'}->{'default_pool_rxrate'})) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Set default_pool_rxrate to '$rxir'");
$config->{'default_pool_rxrate'} = isNumber($rxir);
} else {
$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'})) {
# Lets pull off the class_rate items
my @iclasses;
if (ref($iconfig->{'class_rate'}) eq "ARRAY") {
@iclasses = @{$iconfig->{'class_rate'}};
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] There is a problem with default_pool_rxrate, config item use_default_pool disabled");
@iclasses = ( $iconfig->{'class_rate'} );
}
# Loop with class_rates and parse
foreach my $iclass (@iclasses) {
# Skip comments
next if ($iclass =~ /^\s*#/);
# Split off class ID and class name
my ($itrafficClassID,$iclassCIR,$iclassLimit) = split(/[:\/]/,$iclass);
if (!defined($itrafficClassID = isTrafficClassIDValid($itrafficClassID))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class definition '%s' has invalid Class ID, ignoring ".
"definition",
$interface,
$iclass
);
next;
}
# If the CIR is defined, try use it
if (defined($iclassCIR)) {
# If its not a number, something is wrong
if ($iclassCIR =~ /^([1-9][0-9]*)(%)?$/) {
my ($cir,$percent) = ($1,$2);
# Check if this is a percentage or an actual kbps value
if (defined($percent)) {
$iclassCIR = int($interfaceLimit * ($cir / 100));
} else {
$iclassCIR = $cir;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has invalid CIR, ignoring definition",
$interface,
$itrafficClassID
);
next;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has missing CIR, ignoring definition",
$interface,
$itrafficClassID
);
next;
}
# If the limit is defined, try use it
if (defined($iclassLimit)) {
# If its not a number, something is wrong
if ($iclassLimit =~ /^([1-9][0-9]*)(%)?$/) {
my ($Limit,$percent) = ($1,$2);
# Check if this is a percentage or an actual kbps value
if (defined($percent)) {
$iclassLimit = int($interfaceLimit * ($Limit / 100));
} else {
$iclassLimit = $Limit;
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface '%s' class '%s' has invalid Limit, ignoring",
$interface,
$itrafficClassID
);
next;
}
} else {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has missing Limit, using CIR '%s' instead",
$interface,
$itrafficClassID,
$iclassCIR
);
$iclassLimit = $iclassCIR;
}
# Check if rates are below are sane
if ($iclassCIR > $interfaceLimit) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > interface speed '%s', ".
"adjusting to '%s'",
$interface,
$itrafficClassID,
$iclassCIR,
$interfaceLimit,
$interfaceLimit
);
$iclassCIR = $interfaceLimit;
}
if ($iclassLimit > $interfaceLimit) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has Limit '%s' > interface speed '%s', ".
"adjusting to '%s'",
$interface,
$itrafficClassID,
$iclassCIR,
$interfaceLimit,
$interfaceLimit
);
$iclassLimit = $interfaceLimit;
}
if ($iclassCIR > $iclassLimit) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Interface '%s' class '%s' has CIR '%s' > Limit '%s', adjusting CIR ".
"to '%s'",
$interface,
$itrafficClassID,
$iclassLimit,
$iclassLimit,
$iclassLimit
);
$iclassCIR = $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,
$itrafficClassID,
$iclassCIR,
$iclassLimit
);
}
}
# 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
);
}
# Check we have both items configured, if not deconfigure
if (!defined($config->{'default_pool_txrate'}) || !defined($config->{'default_pool_rxrate'})) {
$config->{'use_default_pool'} = 0;
}
}
$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 @cinterfaceGroups;
if (defined($gconfig->{'interface_group'})) {
if (ref($gconfig->{'interface_group'}) eq "ARRAY") {
@cinterfaceGroups = @{$gconfig->{'interface_group'}};
} else {
@cinterfaceGroups = ( $gconfig->{'interface_group'} );
}
} else {
@cinterfaceGroups = ( "eth1,eth0:Default" );
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] No interface groups, trying default eth1,eth0");
}
# Loop with interface groups
foreach my $interfaceGroup (@cinterfaceGroups) {
# Skip comments
next if ($interfaceGroup =~ /^\s*#/);
# Split off class ID and class name
my ($txInterface,$rxInterface,$friendlyName) = split(/[:,]/,$interfaceGroup);
if (!isInterfaceIDValid($txInterface)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface group definition '%s' has invalid interface '%s', ignoring",
$interfaceGroup,
$txInterface
);
next;
}
if (!isInterfaceIDValid($rxInterface)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface group definition '%s' has invalid interface '%s', ignoring",
$interfaceGroup,
$rxInterface
);
next;
}
if (!defined($friendlyName) || $friendlyName eq "") {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Interface group definition '%s' has invalid friendly name, ignoring",
$interfaceGroup,
);
next;
}
# 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' [%s] with interfaces '%s/%s'",
$friendlyName,
$interfaceGroupID,
$txInterface,
$rxInterface
);
}
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Interface groups loaded");
# Check if we using a default pool or not
if (defined($gconfig->{'default_pool'})) {
# Check if its a number
if (defined(my $default_pool = isNumber($gconfig->{'default_pool'}))) {
if (isTrafficClassIDValid($default_pool)) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Default pool set to use class '%s'",
$default_pool
);
$globals->{'DefaultPool'} = $default_pool;
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot enable default pool, class '%s' does not exist",
$default_pool
);
}
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot enable default pool, value for 'default_pool' is invalid");
}
}
$logger->log(LOG_INFO,"[CONFIGMANAGER] Using of default pool ". ( $config->{'use_default_pool'} ?
"ENABLED with rates $config->{'default_pool_txrate'}/$config->{'default_pool_rxrate'}" : "DISABLED" ) );
# 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 '$statefile'");
$logger->log(LOG_INFO,"[CONFIGMANAGER] Set statefile to '%s'",$statefile);
}
# This is our configuration processing session
POE::Session->create(
inline_states => {
_start => \&session_start,
_stop => \&session_stop,
_start => \&_session_start,
_stop => \&_session_stop,
_tick => \&_session_tick,
_SIGHUP => \&_session_SIGHUP,
limit_add => \&_session_limit_add,
tick => \&session_tick,
pool_override_add => \&_session_pool_override_add,
pool_override_change => \&_session_pool_override_change,
pool_override_remove => \&_session_pool_override_remove,
process_limit_change => \&process_limit_change,
process_override_change => \&process_override_change,
pool_add => \&_session_pool_add,
pool_remove => \&_session_pool_remove,
pool_change => \&_session_pool_change,
poolmember_add => \&_session_poolmember_add,
poolmember_remove => \&_session_poolmember_remove,
poolmember_change => \&_session_poolmember_change,
handle_SIGHUP => \&handle_SIGHUP,
}
);
}
# Start the plugin
sub plugin_start
{
$logger->log(LOG_INFO,"[CONFIGMANAGER] Started with ".( keys %{$changeQueue} )." queued items");
# Load config
if (-f $config->{'statefile'}) {
_load_statefile();
} else {
$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 pool overrides",
scalar(keys %{$globals->{'Pools'}}),
scalar(keys %{$globals->{'PoolMembers'}}),
scalar(keys %{$globals->{'PoolOverrides'}})
);
}
# Initialize config manager
sub session_start
sub _session_start
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
......@@ -362,41 +978,32 @@ sub session_start
# Set our alias
$kernel->alias_set("configmanager");
# Load config
if (-f $config->{'statefile'}) {
_load_statefile($kernel);
} else {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Statefile '$config->{'statefile'}' cannot be opened: $!");
}
# Set delay on config updates
$kernel->delay(tick => TICK_PERIOD);
$kernel->delay('_tick' => TICK_PERIOD);
$kernel->sig('HUP', 'handle_SIGHUP');
$kernel->sig('HUP', '_SIGHUP');
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Initialized");
}
# Stop the session
sub session_stop
sub _session_stop
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Shutting down, saving configuration...");
_write_statefile();
# We only need to write the sate if something changed?
if ($globals->{'StateChanged'}) {
# The 1 means FULL WRITE of all entries
_write_statefile(1);
}
# Blow away all data
$globals = undef;
$changeQueue = { };
$limits = { };
$limitIPMap = { };
$limitIDMap = { };
$limitIDCounter = 1;
$overrides = { };
# XXX: Blow away rest? config?
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Shutdown");
......@@ -404,727 +1011,3048 @@ sub session_stop
}
# Time ticker for processing changes
sub session_tick
sub _session_tick
{
my $kernel = $_[KERNEL];
_process_limit_change_queue($kernel);
# Reset tick
$kernel->delay(tick => TICK_PERIOD);
}
my $now = time();
# Process limit change
sub process_limit_change
{
my ($kernel, $limit) = @_[KERNEL, ARG0];
# Check if we should sync state to disk
if ($globals->{'StateChanged'} && $globals->{'LastStateSync'} + STATE_SYNC_INTERVAL < $now) {
_write_statefile();
}
_process_limit_change($limit);
}
# Process override change
sub process_override_change
{
my ($kernel, $override) = @_[KERNEL, ARG0];
# Check if we should cleanup
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
);
removePoolOverride($poid);
}
}
# Loop with all pool members and check for expired entries
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",
$poolMember->{'Username'},
$pmid
);
removePoolMember($pmid);
}
}
# Loop with all the pools and check for expired entries
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
if (getPoolMembers($pid) == 0) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] has expired, removing",
$pool->{'Name'},
$pid
);
removePool($pid);
}
}
}
# Reset last cleanup time
$globals->{'LastCleanup'} = $now;
}
_process_override_change($override);
}
# 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
);
}
# Function to check the group ID exists
sub checkGroupID
{
my $gid = shift;
if (defined($config->{'groups'}->{$gid})) {
return $gid;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Interface traffic class [%s] has UNKNOWN status '%s'",
$interfaceTrafficClassID,
$interfaceTrafficClass->{'Status'}
);
}
}
return;
}
# Function to check the class ID exists
sub checkClassID
{
my $cid = shift;
if (defined($config->{'classes'}->{$cid})) {
return $cid;
}
return;
}
# Loop through pool change queue
while (my ($pid, $pool) = each(%{$globals->{'PoolChangeQueue'}})) {
my $shaperState = getPoolShaperState($pid);
# Pool is newly added
if ($pool->{'Status'} == CFGM_NEW) {
# Function to check if the status is ok
sub checkStatus
{
my $status = shift;
if ($status eq "new" || $status eq "offline" || $status eq "online" || $status eq "conflict" || $status eq "unknown") {
return $status
}
return;
}
# If the change is not yet live, we should queue it to go live
if ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] new and is not live, adding to shaper",
$pool->{'Name'},
$pid
);
$kernel->post('shaper' => 'pool_add' => $pid);
# Set pending online
setPoolShaperState($pid,SHAPER_PENDING);
$pool->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($globals->{'PoolChangeQueue'}->{$pid});
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$pid,
$shaperState
);
}
# Function to return a limit username
sub getLimitUsername
{
my $lid = shift;
if (defined($limits->{$lid})) {
return $limits->{$lid}->{'Username'};
}
return;
}
# Pool is online but NOTLIVE
} elsif ($pool->{'Status'} == CFGM_ONLINE) {
# We've transitioned more than likely from offline, any state to online
# We don't care if the shaper is pending removal, we going to force re-adding now
if (!($shaperState & SHAPER_LIVE)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] online and is not live, re-queue as add",
$pool->{'Name'},
$pid
);
$pool->{'Status'} = CFGM_NEW;
# Function to return a limit
sub getLimit
{
my $lid = shift;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$pid,
$shaperState
);
}
if (defined($limits->{$lid})) {
my %limit = %{$limits->{$lid}};
return \%limit;
}
return;
# 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",
$pool->{'Name'},
$pid
);
$kernel->post('shaper' => 'pool_change' => $pid);
# Set pending online
setPoolShaperState($pid,SHAPER_PENDING);
$pool->{'Status'} = CFGM_ONLINE;
# Remove from queue
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",
$pool->{'Name'},
$pid
);
$pool->{'Status'} = CFGM_NEW;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$pid,
$shaperState
);
}
# Pool is being removed?
} elsif ($pool->{'Status'} == CFGM_OFFLINE) {
# If the change is live, but should go offline, queue it
if ($shaperState & SHAPER_LIVE) {
if ($now - $pool->{'LastUpdate'} > TIMEOUT_EXPIRE_OFFLINE) {
# If we still have pool members, we got to abort
if (!getPoolMembers($pid)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] marked offline and expired, removing from shaper",
$pool->{'Name'},
$pid
);
$kernel->post('shaper' => 'pool_remove' => $pid);
setPoolShaperState($pid,SHAPER_PENDING);
} else {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] marked offline, but still has pool members, ".
"aborting remove",
$pool->{'Name'},
$pid
);
$pool->{'Status'} = CFGM_ONLINE;
delete($globals->{'PoolChangeQueue'}->{$pid});
}
} else {
# Try remove all our pool members
if (my @poolMembers = getPoolMembers($pid)) {
# Loop with members and remove
foreach my $pmid (@poolMembers) {
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 ".
"pool member [%s]",
$pool->{'Name'},
$pid,
$pmid
);
removePoolMember($pmid);
}
}
}
}
} elsif ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' [%s] marked offline and is not live, removing",
$pool->{'Name'},
$pid
);
# Remove pool from name map
delete($globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}});
# Remove pool member mapping
delete($globals->{'PoolMemberMap'}->{$pid});
# Remove from queue
delete($globals->{'PoolChangeQueue'}->{$pid});
# Cleanup pool overrides
_remove_pool_override($pid);
# Remove pool
delete($globals->{'Pools'}->{$pid});
}
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' [%s] has UNKNOWN status '%s'",
$pool->{'Name'},
$pid,
$pool->{'Status'}
);
}
}
# Loop through pool member change queue
while (my ($pmid, $poolMember) = each(%{$globals->{'PoolMemberChangeQueue'}})) {
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($pmid);
# Pool member is newly added
if ($poolMember->{'Status'} == CFGM_NEW) {
# If the change is not yet live, we should queue it to go live
if ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] new and is not live, adding to shaper",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
$kernel->post('shaper' => 'poolmember_add' => $pmid);
# Set pending online
setPoolMemberShaperState($pmid,SHAPER_PENDING);
$poolMember->{'Status'} = CFGM_ONLINE;
# Remove from queue
delete($globals->{'PoolMemberChangeQueue'}->{$pmid});
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid,
$shaperState
);
}
# Pool member is online but NOTLIVE
} elsif ($poolMember->{'Status'} == CFGM_ONLINE) {
# We've transitioned more than likely from offline, any state to online
# We don't care if the shaper is pending removal, we going to force re-adding now
if (!($shaperState & SHAPER_LIVE)) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] online and is not live, re-queue as add",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
$poolMember->{'Status'} = CFGM_NEW;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid,
$shaperState
);
}
# Pool member has been modified
} elsif ($poolMember->{'Status'} == CFGM_CHANGED) {
# If the shaper is live we can go ahead
if ($shaperState & SHAPER_LIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has been modified, sending to shaper",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
$kernel->post('shaper' => 'poolmember_change' => $pmid);
# Set pending online
setPoolMemberShaperState($pmid,SHAPER_PENDING);
$poolMember->{'Status'} = CFGM_ONLINE;
# Remove from queue
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 ".
"add",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
$poolMember->{'Status'} = CFGM_NEW;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has UNKNOWN state '%s'",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid,
$shaperState
);
}
# Pool is being removed?
} elsif ($poolMember->{'Status'} == CFGM_OFFLINE) {
# If the change is live, but should go offline, queue it
if ($shaperState & SHAPER_LIVE) {
if ($now - $poolMember->{'LastUpdate'} > TIMEOUT_EXPIRE_OFFLINE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] marked offline and expired, removing ".
"from shaper",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
$kernel->post('shaper' => 'poolmember_remove' => $pmid);
setPoolMemberShaperState($pmid,SHAPER_PENDING);
} else {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] marked offline and fresh, postponing",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
}
} elsif ($shaperState & SHAPER_NOTLIVE) {
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] marked offline and is not live, removing",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid
);
# Unlink interface IP address map
delete($globals->{'InterfaceGroups'}->{$pool->{'InterfaceGroupID'}}->{'IPMap'}->{$poolMember->{'IPAddress'}}
->{$pmid});
# Unlink pool map
delete($globals->{'PoolMemberMap'}->{$pool->{'ID'}}->{$pmid});
# Remove from queue
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($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 {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Pool '%s' member '%s' [%s] has UNKNOWN status '%s'",
$pool->{'Name'},
$poolMember->{'IPAddress'},
$pmid,
$poolMember->{'Status'}
);
}
}
# Reset tick
$kernel->delay('_tick' => TICK_PERIOD);
}
# Handle SIGHUP
sub _session_SIGHUP
{
my ($kernel, $heap, $signal_name) = @_[KERNEL, HEAP, ARG0];
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Got SIGHUP, ignoring for now");
}
# Event for 'pool_add'
sub _session_pool_add
{
my ($kernel, $poolData) = @_[KERNEL, ARG0];
if (!defined($poolData)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] No pool data provided for 'pool_add' event");
return;
}
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (POOL_REQUIRED_ATTRIBUTES) {
if (!defined($poolData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add as there is an attribute missing: '%s'",
$isInvalid
);
return;
}
createPool($poolData);
}
# Event for 'pool_remove'
sub _session_pool_remove
{
my ($kernel, $pid) = @_[KERNEL, ARG0];
my $pool;
if (!defined(getPool($pid))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_remove' event",prettyUndef($pid));
return;
}
removePool($pid);
}
# Event for 'pool_change'
sub _session_pool_change
{
my ($kernel, $poolData) = @_[KERNEL, ARG0];
if (!isPoolIDValid($poolData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Invalid pool ID '%s' for 'pool_change' event",prettyUndef($poolData->{'ID'}));
return;
}
changePool($poolData);
}
# Event for 'poolmember_add'
sub _session_poolmember_add
{
my ($kernel, $poolMemberData) = @_[KERNEL, ARG0];
if (!defined($poolMemberData)) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] No pool member data provided for 'poolmember_add' event");
return;
}
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (POOLMEMBER_REQUIRED_ATTRIBUTES) {
if (!defined($poolMemberData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process poolmember add as there is an attribute missing: '%s',$isInvalid");
return;
}
createPoolMember($poolMemberData);
}
# Event for 'poolmember_remove'
sub _session_poolmember_remove
{
my ($kernel, $pmid) = @_[KERNEL, ARG0];
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;
}
$globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'} &= ~$state;
return $globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'};
}
# Function to get shaper state for a interface traffic class
sub getInterfaceTrafficClassShaperState
{
my $interfaceTrafficClassID = shift;
# Check interface traffic class exists first
if (!isInterfaceTrafficClassIDValid2($interfaceTrafficClassID)) {
return;
}
return $globals->{'InterfacesTrafficClasses'}->{$interfaceTrafficClassID}->{'.shaper_state'};
}
# Function to get all traffic classes
sub getAllTrafficClasses
{
return ( keys %{$globals->{'TrafficClasses'}} );
}
# Function to get a traffic class
sub getTrafficClass
{
my $trafficClassID = shift;
if (!isTrafficClassIDValid($trafficClassID)) {
return;
}
return $globals->{'TrafficClasses'}->{$trafficClassID};
}
# Function to check if traffic class is valid
sub isTrafficClassIDValid
{
my $trafficClassID = shift;
if (!defined($trafficClassID) || !defined($globals->{'TrafficClasses'}->{$trafficClassID})) {
return;
}
return $trafficClassID;
}
# Function to return the traffic priority based on a traffic class
sub getTrafficClassPriority
{
my $trafficClassID = shift;
# Check it exists first
if (!isTrafficClassIDValid($trafficClassID)) {
return;
}
# NK: Short circuit, our TrafficClassID = Priority
return $trafficClassID;
}
# Function to create an interface
sub createInterface
{
my $interfaceData = shift;
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;
}
# 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;
}
# 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;
# Create interface main traffic class
createInterfaceTrafficClass({
'InterfaceID' => $interface->{'ID'},
'TrafficClassID' => 0,
'CIR' => $interfaceData->{'Limit'},
'Limit' => $interfaceData->{'Limit'},
});
return $interface->{'ID'};
}
# Function to return if an interface ID is valid
sub isInterfaceIDValid
{
my $interfaceID = shift;
# Return undef if interface is not valid
if (!defined($globals->{'Interfaces'}->{$interfaceID})) {
return;
}
return $interfaceID;
}
# Function to return the configured Interfaces
sub getInterfaces
{
return ( keys %{$globals->{'Interfaces'}} );
}
# Return interface classes
sub getInterface
{
my $interfaceID = shift;
# Check if interface ID is valid
if (!isInterfaceIDValid($interfaceID)) {
return;
}
my $res = dclone($globals->{'Interfaces'}->{$interfaceID});
# We don't want to return TrafficClasses
delete($res->{'TrafficClasses'});
# And return it...
return $res;
}
# Function to return our default pool configuration
sub getInterfaceDefaultPool
{
my $interface = shift;
# We don't really need the interface to return the default pool
return $globals->{'DefaultPool'};
}
# Function to create an interface group
sub createInterfaceGroup
{
my $interfaceGroupData = shift;
my $interfaceGroup;
# 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;
}
# 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
{
return ( keys %{$globals->{'InterfaceGroups'}} );
}
# Function to get an interface group
sub getInterfaceGroup
{
my $interfaceGroupID = shift;
if (!isInterfaceGroupIDValid($interfaceGroupID)) {
return;
}
my $interfaceGroup = dclone($globals->{'InterfaceGroups'}->{$interfaceGroupID});
delete($interfaceGroup->{'IPMap'});
return $interfaceGroup;
}
# Function to check if interface group is valid
sub isInterfaceGroupIDValid
{
my $interfaceGroupID = shift;
if (!defined($interfaceGroupID) || !defined($globals->{'InterfaceGroups'}->{$interfaceGroupID})) {
return;
}
return $interfaceGroupID;
}
# Function to get match priorities
sub getMatchPriorities
{
return dclone($config->{'match_priorities'});
}
# Function to check if interface group is valid
sub isMatchPriorityIDValid
{
my $mpid = shift;
# Check all is ok
if (!defined($mpid) || !defined($config->{'match_priorities'}->{$mpid})) {
return;
}
return $mpid;
}
# Function to set a pool attribute
sub setPoolAttribute
{
my ($pid,$attr,$value) = @_;
# Return if it doesn't exist
if (!isPoolIDValid($pid)) {
return;
}
$globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr} = $value;
return $value;
}
# Function to get a pool attribute
sub getPoolAttribute
{
my ($pid,$attr) = @_;
# Return if it doesn't exist
if (!isPoolIDValid($pid)) {
return;
}
# Check if attribute exists first
if (
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}) ||
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr}))
{
return;
}
return $globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr};
}
# Function to remove a pool attribute
sub removePoolAttribute
{
my ($pid,$attr) = @_;
# Return if it doesn't exist
if (!isPoolIDValid($pid)) {
return;
}
# Check if attribute exists first
if (
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}) ||
!defined($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr}))
{
return;
}
return delete($globals->{'Pools'}->{$pid}->{'.attributes'}->{$attr});
}
# Function to return a pool override
sub getPoolOverride
{
my $poid = shift;
if (!isPoolOverrideIDValid($poid)) {
return;
}
my $poolOverride = dclone($globals->{'PoolOverrides'}->{$poid});
return $poolOverride;
}
## Function to return a list of pool override ID's
sub getPoolOverrides
{
return (keys %{$globals->{'PoolOverrides'}});
}
# Function to create a pool
sub createPool
{
my $poolData = shift;
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (POOL_REQUIRED_ATTRIBUTES) {
if (!defined($poolData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool add for '%s' as there is an attribute missing: '%s'",
prettyUndef($poolData->{'Name'}),
$isInvalid
);
return;
}
my $pool;
my $now = time();
# Now check if the name is valid
if (!defined($pool->{'Name'} = $poolData->{'Name'})) {
$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_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 = $globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}})) {
return $pool->{'ID'};
}
# Check class is OK
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($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->{'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->{'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->{'TxLimit'} = $poolData->{'TxLimit'})) {
$pool->{'TxLimit'} = $pool->{'TxCIR'};
$pool->{'TxCIR'} = int($pool->{'TxLimit'}/4);
}
if (!defined($pool->{'RxLimit'} = $poolData->{'RxLimit'})) {
$pool->{'RxLimit'} = $pool->{'RxCIR'};
$pool->{'RxCIR'} = int($pool->{'RxLimit'}/4);
}
# Set source
$pool->{'Source'} = $poolData->{'Source'};
# Set when this entry was created
$pool->{'Created'} = defined($poolData->{'Created'}) ? $poolData->{'Created'} : $now;
$pool->{'LastUpdate'} = $now;
# Set when this entry expires
$pool->{'Expires'} = defined($poolData->{'Expires'}) ? int($poolData->{'Expires'}) : 0;
# Check status is OK
$pool->{'Status'} = CFGM_NEW;
# Set friendly name and notes
$pool->{'FriendlyName'} = $poolData->{'FriendlyName'};
# Set notes
$pool->{'Notes'} = $poolData->{'Notes'};
# Assign pool ID
$pool->{'ID'} = $globals->{'PoolIDCounter'}++;
# NK: Need better pool ID determination, check what ID is available
# Add pool
$globals->{'Pools'}->{$pool->{'ID'}} = $pool;
# Link pool name map
$globals->{'PoolNameMap'}->{$pool->{'InterfaceGroupID'}}->{$pool->{'Name'}} = $pool;
# Blank our pool member mapping
$globals->{'PoolMemberMap'}->{$pool->{'ID'}} = { };
setPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE);
# Pool needs updating
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Resolve pool overrides
_resolve_pool_override([$pool->{'ID'}]);
# Bump up changes
$globals->{'StateChanged'}++;
return $pool->{'ID'};
}
# Function to remove a pool
sub removePool
{
my $pid = shift;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
my $pool = $globals->{'Pools'}->{$pid};
# Check if pool is not already offlining
if ($pool->{'Status'} == CFGM_OFFLINE) {
return;
}
my $now = time();
# Set status to offline so its caught by our garbage collector
$pool->{'Status'} = CFGM_OFFLINE;
# Updated pool's last updated timestamp
$pool->{'LastUpdate'} = $now;
# Pool needs updating
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Bump up changes
$globals->{'StateChanged'}++;
return;
}
# Function to change a pool
sub changePool
{
my $poolData = shift;
# Check pool exists first
if (!isPoolIDValid($poolData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool change as there is no 'ID' attribute");
return;
}
my $pool = $globals->{'Pools'}->{$poolData->{'ID'}};
my $now = time();
my $changes = getHashChanges($pool,$poolData,[POOL_CHANGE_ATTRIBUTES]);
# Make changes...
foreach my $item (keys %{$changes}) {
$pool->{$item} = $changes->{$item};
}
# Set pool to being updated
$pool->{'Status'} = CFGM_CHANGED;
# Pool was just updated, so update our timestamp
$pool->{'LastUpdate'} = $now;
# Pool needs updating
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
# Bump up changes
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to return a pool
sub getPool
{
my $pid = shift;
if (!isPoolIDValid($pid)) {
return;
}
my $pool = dclone($globals->{'Pools'}->{$pid});
# Remove attributes?
delete($pool->{'.attributes'});
delete($pool->{'.applied_overrides'});
return $pool;
}
# Function to get a pool by its name
sub getPoolByName
{
my ($interfaceGroupID,$name) = @_;
# Make sure both params are defined or we get warnings
if (!defined($interfaceGroupID) || !defined($name)) {
return;
}
# Maybe it doesn't exist?
if (
!defined($globals->{'PoolNameMap'}->{$interfaceGroupID}) ||
!defined($globals->{'PoolNameMap'}->{$interfaceGroupID}->{$name}))
{
return;
}
return dclone($globals->{'PoolNameMap'}->{$interfaceGroupID}->{$name});
}
# Function to return a list of pool ID's
sub getPools
{
return (keys %{$globals->{'Pools'}});
}
# Function to return a pool TX interface
sub getPoolTxInterface
{
my $pid = shift;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
return $globals->{'InterfaceGroups'}->{$globals->{'Pools'}->{$pid}->{'InterfaceGroupID'}}->{'TxInterface'};
}
# Function to return a pool RX interface
sub getPoolRxInterface
{
my $pid = shift;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
return $globals->{'InterfaceGroups'}->{$globals->{'Pools'}->{$pid}->{'InterfaceGroupID'}}->{'RxInterface'};
}
# Function to return a pool traffic class ID
sub getPoolTrafficClassID
{
my $pid = shift;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
return $globals->{'Pools'}->{$pid}->{'TrafficClassID'};
}
# Function to set pools shaper state
sub setPoolShaperState
{
my ($pid,$state) = @_;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
$globals->{'Pools'}->{$pid}->{'.shaper_state'} |= $state;
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to return a list of limit ID's
sub getLimits
# Function to unset pools shaper state
sub unsetPoolShaperState
{
return (keys %{$limits});
my ($pid,$state) = @_;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
$globals->{'Pools'}->{$pid}->{'.shaper_state'} &= ~$state;
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to set a limit attribute
sub setLimitAttribute
# Function to get shaper state for a pool
sub getPoolShaperState
{
my ($lid,$attr,$value) = @_;
my $pid = shift;
# Only set it if it exists
if (defined($limits->{$lid})) {
$limits->{$lid}->{'attributes'}->{$attr} = $value;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
return;
return $globals->{'Pools'}->{$pid}->{'.shaper_state'};
}
# Function to check the pool ID exists
sub isPoolIDValid
{
my $pid = shift;
if (!defined($pid) || !defined($globals->{'Pools'}->{$pid})) {
return;
}
return $pid;
}
# Function to get a limit attribute
sub getLimitAttribute
# Function to return if a pool is ready for any kind of modification
sub isPoolReady
{
my ($lid,$attr) = @_;
my $pid = shift;
# Check if attribute exists first
if (defined($limits->{$lid}) && defined($limits->{$lid}->{'attributes'}) && defined($limits->{$lid}->{'attributes'}->{$attr})) {
return $limits->{$lid}->{'attributes'}->{$attr};
# Get state and check pool exists all in one
my $state;
if (!defined($state = getPoolShaperState($pid))) {
return;
}
return;
return ($globals->{'Pools'}->{$pid}->{'Status'} == CFGM_ONLINE && $state & SHAPER_LIVE);
}
# 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;
my $pool;
if (!defined($pool = getPool($pid))) {
return;
}
my $realPool = $globals->{'Pools'}->{$pid};
# If we have applied pool overrides, check out what changes there may be
if (defined(my $appliedPoolOverrides = $realPool->{'.applied_overrides'})) {
my $poolOverrideSet;
# 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 pool overrides on pool
if (defined($poolOverrideSet)) {
foreach my $attr (keys %{$poolOverrideSet}) {
$pool->{$attr} = $poolOverrideSet->{$attr};
}
}
}
return $pool;
}
# Function to create a pool member
sub createPoolMember
{
my $poolMemberData = shift;
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (POOLMEMBER_REQUIRED_ATTRIBUTES) {
if (!defined($poolMemberData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool member add as there is an attribute missing: '%s'",$isInvalid);
return;
}
my $poolMember;
my $now = time();
# Check if IP address is defined
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'}, 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_WARN,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the PoolID is invalid",
$poolMemberData->{'Username'}
);
return;
}
# Grab pool
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
# Check match priority ID is OK
if (!defined($poolMember->{'MatchPriorityID'} = isMatchPriorityIDValid($poolMemberData->{'MatchPriorityID'}))) {
$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_WARN,"[CONFIGMANAGER] Cannot process pool member add for '%s' as the GroupID is invalid",
$poolMemberData->{'Username'}
);
return;
}
# Set source
$poolMember->{'Source'} = $poolMemberData->{'Source'};
# Set when this entry was created
$poolMember->{'Created'} = defined($poolMemberData->{'Created'}) ? $poolMemberData->{'Created'} : $now;
$poolMember->{'LastUpdate'} = $now;
# Set when this entry expires
$poolMember->{'Expires'} = defined($poolMemberData->{'Expires'}) ? int($poolMemberData->{'Expires'}) : 0;
# Check status is OK
$poolMember->{'Status'} = CFGM_NEW;
# Set friendly name and notes
$poolMember->{'FriendlyName'} = $poolMemberData->{'FriendlyName'};
# Set notes
$poolMember->{'Notes'} = $poolMemberData->{'Notes'};
# Create pool member ID
$poolMember->{'ID'} = $globals->{'PoolMemberIDCounter'}++;
# Add pool member
$globals->{'PoolMembers'}->{$poolMember->{'ID'}} = $poolMember;
# Link pool map
$globals->{'PoolMemberMap'}->{$pool->{'ID'}}->{$poolMember->{'ID'}} = $poolMember;
# Updated pool's last updated timestamp
$pool->{'LastUpdate'} = $now;
# Make sure pool is online and not offlining
if ($pool->{'Status'} == CFGM_OFFLINE) {
$pool->{'Status'} = CFGM_ONLINE;
}
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_NOTLIVE);
# Check for IP conflicts
if (
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 = $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] Pool '%s' member '%s' IP '%s' conflicts with: %s",
$pool->{'Name'},
$poolMember->{'Username'},
$poolMember->{'IPAddress'},
join(", ",@logItems)
);
# We don't have to add it to the queue, as its in a conflicted state
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_CONFLICT);
} else {
# Pool member needs updating
$globals->{'PoolMemberChangeQueue'}->{$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 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
$globals->{'StateChanged'}++;
return $poolMember->{'ID'};
}
# Function to return a override
sub getOverride
# 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
# cannot allow plugins to remove internal data structures either.
sub removePoolMember
{
my $oid = shift;
my $pmid = shift;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
my $poolMember = $globals->{'PoolMembers'}->{$pmid};
if (defined($overrides->{$oid})) {
my %override = %{$overrides->{$oid}};
return \%override;
# Check if pool member is not already offlining
if ($poolMember->{'Status'} == CFGM_OFFLINE) {
return;
}
my $now = time();
# Grab pool
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
# Updated pool's last updated timestamp
$pool->{'LastUpdate'} = $now;
# Set status to offline so its caught by our garbage collector
$poolMember->{'Status'} = CFGM_OFFLINE;
# Update pool members last updated timestamp
$poolMember->{'LastUpdate'} = $now;
# Pool member needs updating
$globals->{'PoolMemberChangeQueue'}->{$poolMember->{'ID'}} = $poolMember;
# Bump up changes
$globals->{'StateChanged'}++;
return;
}
# Function to return a list of override ID's
sub getOverrides
# Function to change a pool member
sub changePoolMember
{
my $poolMemberData = shift;
# Check pool member exists first
if (!isPoolMemberIDValid($poolMemberData->{'ID'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool change as there is no 'ID' attribute");
return;
}
my $poolMember = $globals->{'PoolMembers'}->{$poolMemberData->{'ID'}};
my $pool = $globals->{'Pools'}->{$poolMember->{'PoolID'}};
my $now = time();
my $changes = getHashChanges($poolMember,$poolMemberData,[POOLMEMBER_CHANGE_ATTRIBUTES]);
# Make changes...
foreach my $item (keys %{$changes}) {
$poolMember->{$item} = $changes->{$item};
}
# Pool member isn't really updated, so we just set the last updated timestamp
$poolMember->{'LastUpdate'} = $now;
# Pool was just updated, so update our timestamp
$pool->{'LastUpdate'} = $now;
# Bump up changes
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to return a list of pool ID's
sub getPoolMembers
{
return (keys %{$overrides});
my $pid = shift;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
# Check our member map is not undefined
if (!defined($globals->{'PoolMemberMap'}->{$pid})) {
return;
}
return keys %{$globals->{'PoolMemberMap'}->{$pid}};
}
# Function to set shaper state on a limit
sub setShaperState
# Function to return a pool member
sub getPoolMember
{
my ($lid,$state) = @_;
my $pmid = shift;
if (defined($limits->{$lid})) {
$limits->{$lid}->{'_shaper.state'} = $state;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
my $poolMember = dclone($globals->{'PoolMembers'}->{$pmid});
# Remove attributes?
delete($poolMember->{'.attributes'});
return $poolMember;
}
# Function to get shaper state on a limit
sub getShaperState
# Function to return a list of pool ID's
sub getPoolMemberByUsernameIP
{
my $lid = shift;
if (defined($limits->{$lid})) {
return $limits->{$lid}->{'_shaper.state'};
my ($pid,$username,$ipAddress) = @_;
# Check pool exists first
if (!isPoolIDValid($pid)) {
return;
}
# Check our member map is not undefined
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 %{$globals->{'PoolMemberMap'}->{$pid}}) {
my $poolMember = $globals->{'PoolMemberMap'}->{$pid}->{$pmid};
if ($poolMember->{'Username'} eq $username && $poolMember->{'IPAddress'} eq $ipAddress) {
return $pmid;
}
}
return;
}
# Function to get traffic classes
sub getTrafficClasses
# Function to return pool member ID's with a certain IP address using an interface group
sub getAllPoolMembersByInterfaceGroupIP
{
my ($interfaceGroupID,$ipAddress) = @_;
# Make sure both params are defined or we get warnings
if (!defined($interfaceGroupID) || !defined($ipAddress)) {
return;
}
# Maybe it doesn't exist?
if (!defined($globals->{'InterfaceGroups'}->{$interfaceGroupID}->{'IPMap'}->{$ipAddress})) {
return;
}
return keys %{$globals->{'InterfaceGroups'}->{$interfaceGroupID}->{'IPMap'}->{$ipAddress}};
}
# Function to check the pool member ID exists
sub isPoolMemberIDValid
{
my $pmid = shift;
if (!defined($pmid) || !defined($globals->{'PoolMembers'}->{$pmid})) {
return;
}
return $pmid;
}
# Function to return if a pool member is ready for any kind of modification
sub isPoolMemberReady
{
my $pmid = shift;
# Check pool exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
return ($globals->{'PoolMembers'}->{$pmid}->{'Status'} == CFGM_ONLINE && getPoolMemberShaperState($pmid) & SHAPER_LIVE);
}
# Function to return a pool member match priority
sub getPoolMemberMatchPriority
{
my $pmid = shift;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
# NK: No actual mappping yet, we just return the ID
return $globals->{'PoolMembers'}->{$pmid}->{'MatchPriorityID'};
}
# Function to set a pool member attribute
sub setPoolMemberAttribute
{
my ($pmid,$attr,$value) = @_;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
$globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr} = $value;
return $value;
}
# Function to set pool member shaper state
sub setPoolMemberShaperState
{
my %classes = %{$config->{'classes'}};
my ($pmid,$state) = @_;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
$globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'} |= $state;
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Function to unset pool member shaper state
sub unsetPoolMemberShaperState
{
my ($pmid,$state) = @_;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
$globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'} &= ~$state;
return \%classes;
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Function to get class name
sub getTrafficClassName
# Function to get shaper state for a pool
sub getPoolMemberShaperState
{
my $class = shift;
return $config->{'classes'}->{$class};
}
my $pmid = shift;
# Function to check if traffic class is valid
sub isTrafficClassValid
{
my $class = shift;
if (defined($config->{'classes'}->{$class})) {
return $class;
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
return;
return $globals->{'PoolMembers'}->{$pmid}->{'.shaper_state'};
}
# Handle SIGHUP
sub handle_SIGHUP
# Function to get a pool member attribute
sub getPoolMemberAttribute
{
my ($kernel, $heap, $signal_name) = @_[KERNEL, HEAP, ARG0];
my ($pmid,$attr) = @_;
$logger->log(LOG_WARN,"[CONFIGMANAGER] Got SIGHUP, ignoring for now");
}
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
# Check if attribute exists first
if (
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}) ||
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr}))
{
return;
}
return $globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr};
}
#
# Internal functions
#
# Function to compute the changes between two users
sub _getLimitChangeset
# Function to remove a pool member attribute
sub removePoolMemberAttribute
{
my ($orig,$new) = @_;
my ($pmid,$attr) = @_;
my $res;
# Loop through what can change
foreach my $item (LIMIT_CHANGESET_ATTRIBUTES) {
# Check if its first set, if it is, check if its changed
if (defined($new->{$item}) && $orig->{$item} ne $new->{$item}) {
# If so record it & make the change
$res->{$item} = $orig->{$item} = $new->{$item};
}
# Check pool member exists first
if (!isPoolMemberIDValid($pmid)) {
return;
}
return $res;
# Check if attribute exists first
if (
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}) ||
!defined($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr}))
{
return;
}
return delete($globals->{'PoolMembers'}->{$pmid}->{'.attributes'}->{$attr});
}
# This is the real function
sub _process_limit_change
# Create a limit, which is the combination of a pool and a pool member
sub createLimit
{
my $limit = shift;
my $limitData = shift;
# Check if we have all the attributes we need
my $isInvalid;
foreach my $attr (LIMIT_REQUIRED_ATTRIBUTES) {
if (!defined($limit->{$attr})) {
if (!defined($limitData->{$attr})) {
$isInvalid = $attr;
last;
}
}
if ($isInvalid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit change as not attributes is missing: '$isInvalid'");
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as there is an attribute missing: '%s'",$isInvalid);
return;
}
# We start off blank so we only pull in whats supported
my $limitChange;
if (!defined($limitChange->{'Username'} = $limit->{'Username'})) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process limit change as username is invalid.");
# Check if IP address is defined
if (!defined(isIPv46CIDR($limitData->{'IPAddress'} = $limitData->{'IPAddress'}))) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit add as the IPAddress is invalid");
return;
}
$limitChange->{'Username'} = $limit->{'Username'};
$limitChange->{'IP'} = $limit->{'IP'};
# Check group is OK
if (!defined($limitChange->{'GroupID'} = checkGroupID($limit->{'GroupID'}))) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process limit change for '".$limit->{'Username'}."' as the GroupID is invalid.");
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->{'FriendlyName'} || $limitData->{'IPAddress'},
'Name' => $poolName,
'InterfaceGroupID' => $limitData->{'InterfaceGroupID'},
'TrafficClassID' => $limitData->{'TrafficClassID'},
'TxCIR' => $limitData->{'TxCIR'},
'TxLimit' => $limitData->{'TxLimit'},
'RxCIR' => $limitData->{'RxCIR'},
'RxLimit' => $limitData->{'RxLimit'},
'Expires' => $limitData->{'Expires'},
'Notes' => $limitData->{'Notes'},
'Source' => $limitData->{'Source'}
};
# If we didn't succeed just exit
my $poolID;
if (!defined($poolID = createPool($poolData))) {
return;
}
# Check class is OK
if (!defined($limitChange->{'ClassID'} = checkClassID($limit->{'ClassID'}))) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process limit change for '".$limit->{'Username'}."' as the ClassID is invalid.");
my $poolMemberData = {
'FriendlyName' => $limitData->{'FriendlyName'},
'Username' => $limitData->{'Username'},
'IPAddress' => $limitData->{'IPAddress'},
'InterfaceGroupID' => $limitData->{'InterfaceGroupID'},
'MatchPriorityID' => $limitData->{'MatchPriorityID'},
'PoolID' => $poolID,
'GroupID' => $limitData->{'GroupID'},
'Expires' => $limitData->{'Expires'},
'Notes' => $limitData->{'Notes'},
'Source' => $limitData->{'Source'}
};
my $poolMemberID;
if (!defined($poolMemberID = createPoolMember($poolMemberData))) {
return;
}
$limitChange->{'TrafficLimitTx'} = $limit->{'TrafficLimitTx'};
$limitChange->{'TrafficLimitRx'} = $limit->{'TrafficLimitRx'};
# Take base limits if we don't have any burst values set
$limitChange->{'TrafficLimitTxBurst'} = $limit->{'TrafficLimitTxBurst'};
$limitChange->{'TrafficLimitRxBurst'} = $limit->{'TrafficLimitRxBurst'};
# If we don't have burst limits, set them to the traffic limit, and reset the limit to 25%
if (!defined($limitChange->{'TrafficLimitTxBurst'})) {
$limitChange->{'TrafficLimitTxBurst'} = $limitChange->{'TrafficLimitTx'};
$limitChange->{'TrafficLimitTx'} = int($limitChange->{'TrafficLimitTxBurst'}/4);
return ($poolMemberID,$poolID);
}
# Function to create a pool override
sub createPoolOverride
{
my $poolOverrideData = shift;
# Check that we have at least one match attribute
my $isValid = 0;
foreach my $item (POOL_OVERRIDE_MATCH_ATTRIBUTES) {
# Bump up $isValid if we have a match attribute
if (defined($poolOverrideData->{$item})) {
$isValid++;
}
}
if (!defined($limitChange->{'TrafficLimitRxBurst'})) {
$limitChange->{'TrafficLimitRxBurst'} = $limitChange->{'TrafficLimitRx'};
$limitChange->{'TrafficLimitRx'} = int($limitChange->{'TrafficLimitRxBurst'}/4);
if (!$isValid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process pool override as there is no selection attribute");
return;
}
my $poolOverride;
# Optional priority, we default to 5
$limitChange->{'TrafficPriority'} = defined($limit->{'TrafficPriority'}) ? $limit->{'TrafficPriority'} : 5;
my $now = time();
# Set when this entry expires
$limitChange->{'Expires'} = defined($limit->{'Expires'}) ? $limit->{'Expires'} : 0;
# Pull in attributes
foreach my $item (POOL_OVERRIDE_ATTRIBUTES) {
$poolOverride->{$item} = $poolOverrideData->{$item};
}
# Set friendly name and notes
$limitChange->{'FriendlyName'} = $limit->{'FriendlyName'};
$limitChange->{'Notes'} = $limit->{'Notes'};
# Check group is OK
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;
}
# Set when this entry was created
$limitChange->{'Created'} = defined($limit->{'Created'}) ? $limit->{'Created'} : time();
# Check class is OK
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
$poolOverride->{'Source'} = $poolOverrideData->{'Source'};
# Set when this entry was created
$poolOverride->{'Created'} = defined($poolOverrideData->{'Created'}) ? $poolOverrideData->{'Created'} : $now;
$poolOverride->{'LastUpdate'} = $now;
# Set when this entry expires
$poolOverride->{'Expires'} = defined($poolOverrideData->{'Expires'}) ? int($poolOverrideData->{'Expires'}) : 0;
# Check status is OK
if (!($limitChange->{'Status'} = checkStatus($limit->{'Status'}))) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Cannot process user change for '".$limit->{'Username'}."' as the Status is invalid.");
$poolOverride->{'Status'} = CFGM_NEW;
# Set friendly name and notes
$poolOverride->{'FriendlyName'} = $poolOverrideData->{'FriendlyName'};
# Set notes
$poolOverride->{'Notes'} = $poolOverrideData->{'Notes'};
# Create pool member ID
$poolOverride->{'ID'} = $globals->{'PoolOverrideIDCounter'}++;
# Add pool override
$globals->{'PoolOverrides'}->{$poolOverride->{'ID'}} = $poolOverride;
# Resolve pool overrides
_resolve_pool_override(undef,[$poolOverride->{'ID'}]);
# Bump up changes
$globals->{'StateChanged'}++;
return $poolOverride->{'ID'};
}
# Function to remove a pool override
sub removePoolOverride
{
my $poid = shift;
# Check pool override exists first
if (!isPoolOverrideIDValid($poid)) {
return;
}
$limitChange->{'Source'} = $limit->{'Source'};
my $poolOverride = $globals->{'PoolOverrides'}->{$poid};
# Create a unique limit identifier
my $limitUniq = $limit->{'Username'} . "/" . $limit->{'IP'};
# If we've not seen it
my $lid;
if (!defined($lid = $limitIDMap->{$limitUniq})) {
# Give it the next limitID in the list
$limitIDMap->{$limitUniq} = $lid = ++$limitIDCounter;
# 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 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) {
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
$pool->{'Status'} = CFGM_CHANGED;
}
}
}
# Set the user ID before we post to the change queue
$limitChange->{'ID'} = $lid;
$limitChange->{'LastUpdate'} = time();
# Push change to change queue
$changeQueue->{$lid} = $limitChange;
# Remove pool override
delete($globals->{'PoolOverrides'}->{$poolOverride->{'ID'}});
# Bump up changes
$globals->{'StateChanged'}++;
return;
}
# This is the real process_override_change function
sub _process_override_change
# Function to change a pool override
sub changePoolOverride
{
my $override = shift;
my $poolOverrideData = shift;
# Pull in mandatory items and check if the result is valid
my $overrideChange;
my $isValid = 0;
foreach my $item (OVERRIDE_REQUIRED_ATTRIBUTES) {
$overrideChange->{$item} = $override->{$item};
$isValid++;
}
# Make sure we have at least 1
if (!$isValid) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process override as there is no selection 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;
}
# Pull in attributes that can be changed
foreach my $item (OVERRIDE_CHANGESET_ATTRIBUTES) {
$overrideChange->{$item} = $override->{$item};
my $poolOverride = $globals->{'PoolOverrides'}->{$poolOverrideData->{'ID'}};
my $now = time();
my $changes = getHashChanges($poolOverride,$poolOverrideData,[POOL_OVERRIDE_CHANGE_ATTRIBUTES]);
# Make changes...
foreach my $item (keys %{$changes}) {
$poolOverride->{$item} = $changes->{$item};
}
# Check group is OK
if (defined($overrideChange->{'GroupID'}) && !checkGroupID($overrideChange->{'GroupID'})) {
$logger->log(LOG_DEBUG,'[CONFIGMANAGER] Cannot process override for "User: %s, IP: %s, GroupID: %s" as the GroupID is invalid.',
prettyUndef($overrideChange->{'Username'}),prettyUndef($overrideChange->{'IP'}),prettyUndef($overrideChange->{'GroupID'})
);
return;
# Set status to updated
$poolOverride->{'Status'} = CFGM_CHANGED;
# Set timestamp
$poolOverride->{'LastUpdate'} = $now;
# 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($poolOverride->{'.applied_pools'}) && (my @pids = keys %{$poolOverride->{'.applied_pools'}}) > 0) {
_resolve_pool_override([@pids],[$poolOverride->{'ID'}]);
}
# Check class is OK
if (defined($overrideChange->{'ClassID'}) && !checkClassID($overrideChange->{'ClassID'})) {
$logger->log(LOG_DEBUG,'[CONFIGMANAGER] Cannot process override for "User: %s, IP: %s, GroupID: %s" as the ClassID is invalid.',
prettyUndef($overrideChange->{'Username'}),prettyUndef($overrideChange->{'IP'}),prettyUndef($overrideChange->{'GroupID'})
);
# Bump up changes
$globals->{'StateChanged'}++;
# Return what was changed
return dclone($changes);
}
# Function to check the pool override ID exists
sub isPoolOverrideIDValid
{
my $poid = shift;
if (!defined($poid) || !defined($globals->{'PoolOverrides'}->{$poid})) {
return;
}
# Set when this entry expires
$overrideChange->{'Expires'} = defined($override->{'Expires'}) ? $override->{'Expires'} : 0;
return $poid;
}
# Set friendly name and notes
$overrideChange->{'FriendlyName'} = $override->{'FriendlyName'};
$overrideChange->{'Notes'} = $override->{'Notes'};
# Set when this entry was created
$overrideChange->{'Created'} = defined($override->{'Created'}) ? $override->{'Created'} : time();
$overrideChange->{'LastUpdate'} = time();
#
# Internal functions
#
# This is our key for this entry
my $oid = sprintf('%s%%%s%%%s',
defined($overrideChange->{'Username'}) ? $overrideChange->{'Username'} : "",
defined($overrideChange->{'IP'}) ? $overrideChange->{'IP'} : "",
defined($overrideChange->{'GroupID'}) ? $overrideChange->{'GroupID'} : ""
);
# Set the user ID before we post to the change queue
$overrideChange->{'Key'} = $oid;
# 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,$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} = $globals->{'Pools'}->{$pid};
}
} else {
$poolHash = $globals->{'Pools'};
}
my $poolOverrideHash;
if (defined($poids)) {
foreach my $poid (@{$poids}) {
$poolOverrideHash->{$poid} = $globals->{'PoolOverrides'}->{$poid};
}
} else {
$poolOverrideHash = $globals->{'PoolOverrides'};
}
# Loop with all pools, keep a list of pid's updated
my $matchList;
while ((my $pid, my $pool) = each(%{$poolHash})) {
# Build a candidate from the pool
my $candidate = {
'PoolName' => $pool->{'Name'},
};
# If we only have 1 member in the pool, add its username, IP and group
if ((my ($pmid) = getPoolMembers($pid)) == 1) {
my $poolMember = getPoolMember($pmid);
$candidate->{'Username'} = $poolMember->{'Username'};
$candidate->{'IPAddress'} = $poolMember->{'IPAddress'};
$candidate->{'GroupID'} = $poolMember->{'GroupID'};
}
# 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 (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}->{$poid} = $numMatches;
} else {
$matchList->{$pid}->{$poid} = undef;
}
}
}
# Loop with the match list
foreach my $pid (keys %{$matchList}) {
my $pool = $globals->{'Pools'}->{$pid};
# Original Effective pool
my $oePool = getEffectivePool($pid);
# Loop with pool overrides for this pool
foreach my $poid (keys %{$matchList->{$pid}}) {
my $poolOverride = $globals->{'PoolOverrides'}->{$poid};
$overrides->{$oid} = $overrideChange;
# If we have a match, record it in pools & pool overrides
if (defined($matchList->{$pid}->{$poid})) {
# Setup trakcing of what is applied to what
$globals->{'PoolOverrides'}->{$poid}->{'.applied_pools'}->{$pid} = $matchList->{$pid}->{$poid};
$globals->{'Pools'}->{$pid}->{'.applied_overrides'}->{$poid} = $matchList->{$pid}->{$poid};
$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 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'}
);
}
}
}
# New Effective pool
my $nePool = getEffectivePool($pid);
# Get changes between effective pool states
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;
$globals->{'PoolChangeQueue'}->{$pool->{'ID'}} = $pool;
}
}
}
}
# Load our statefile
sub _load_statefile
# Remove pool override information
sub _remove_pool_override
{
my $kernel = shift;
my $pid = shift;
if (!isPoolIDValid($pid)) {
return;
}
my $pool = $globals->{'Pools'}->{$pid};
# Remove pool from pool overrides if there are any
if (defined($pool->{'.applied_overrides'})) {
foreach my $poid (keys %{$pool->{'.applied_overrides'}}) {
delete($globals->{'PoolOverrides'}->{$poid}->{'.applied_pools'}->{$pool->{'ID'}});
}
}
}
# Load our statefile
sub _load_statefile
{
# Check if the state file exists first of all
if (! -e $config->{'statefile'}) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Statefile '".$config->{'statefile'}."' doesn't exist");
if (! -f $config->{'statefile'}) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Statefile '%s' doesn't exist",$config->{'statefile'});
return;
}
if (! -s $config->{'statefile'}) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Statefile '%s' has zero size ignoring",$config->{'statefile'});
return;
}
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Loading statefile '%s'",$config->{'statefile'});
# Pull in a hash for our statefile
my %stateHash;
if (! tie %stateHash, 'Config::IniFiles', ( -file => $config->{'statefile'} )) {
my $reason = $1 || "Config file blank?";
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to open statefile '".$config->{'statefile'}."': $reason");
# NK: Breaks load on blank file
# Check if we got errors, if we did use them for our reason
my @errors = @Config::IniFiles::errors;
my $reason = $1 || join('; ',@errors);
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to open statefile '%s': %s",$config->{'statefile'},$reason);
# Set it to undef so we don't overwrite it...
#$config->{'statefile'} = undef;
if (@errors) {
$config->{'statefile'} = undef;
}
return;
}
# Grab the object handle
my $state = tied( %stateHash );
# Loop with user overrides
foreach my $section ($state->GroupMembers('override')) {
my $override = $stateHash{$section};
# Our user override
my $ouser;
foreach my $attr (OVERRIDE_PERSISTENT_ATTRIBUTES) {
if (defined($override->{$attr})) {
$ouser->{$attr} = $override->{$attr};
# 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};
}
}
# Check username, IP or gorup ID is defined
if (!defined($ouser->{'Key'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load override with no Key '$section'");
next;
# 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 $cPoolOverride;
foreach my $attr (POOL_OVERRIDE_PERSISTENT_ATTRIBUTES) {
if (defined($poolOverride->{$attr})) {
# If its an array, join all the items
if (ref($poolOverride->{$attr}) eq "ARRAY") {
$poolOverride->{$attr} = join("\n",@{$poolOverride->{$attr}});
}
$cPoolOverride->{$attr} = $poolOverride->{$attr};
}
}
$overrides->{$ouser->{'Key'}} = $ouser;
# Proces this pool override
createPoolOverride($cPoolOverride);
}
# Loop with persistent users
foreach my $section ($state->GroupMembers('persist')) {
my $user = $stateHash{$section};
# We need a pool ID translation, when we recreate pools we get different ID's, we cannot restore members with orignal ID's
my %pidMap;
# User to push through to process change
my $cuser;
foreach my $attr (LIMIT_PERSISTENT_ATTRIBUTES) {
if (defined($user->{$attr})) {
$cuser->{$attr} = $user->{$attr};
# Loop with pools
foreach my $section ($state->GroupMembers('pool')) {
my $pool = $stateHash{$section};
# Loop with the attributes to create the hash
my $cpool;
foreach my $attr (POOL_PERSISTENT_ATTRIBUTES) {
if (defined($pool->{$attr})) {
# If its an array, join all the items
if (ref($pool->{$attr}) eq "ARRAY") {
$pool->{$attr} = join("\n",@{$pool->{$attr}});
}
$cpool->{$attr} = $pool->{$attr};
}
}
# This is a new entry
$cuser->{'Status'} = 'new';
# Check username & IP are defined
if (!defined($cuser->{'Username'}) || !defined($cuser->{'IP'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Failed to load persistent user with no username or IP '$section'");
next;
# Process this pool
if (defined(my $pid = createPool($cpool))) {
# Save the new ID
$pidMap{$pool->{'ID'}} = $pid;
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to load pool '%s' [%s], members will be ignored",
prettyUndef($cpool->{'Name'}),
$section
);
}
}
# Loop with pool members
foreach my $section ($state->GroupMembers('pool_member')) {
my $poolMember = $stateHash{$section};
# Loop with the attributes to create the hash
my $cpoolMember;
foreach my $attr (POOLMEMBER_PERSISTENT_ATTRIBUTES) {
if (defined($poolMember->{$attr})) {
# If its an array, join all the items
if (ref($poolMember->{$attr}) eq "ARRAY") {
$poolMember->{$attr} = join("\n",@{$poolMember->{$attr}});
}
$cpoolMember->{$attr} = $poolMember->{$attr};
}
}
# Process this user
_process_limit_change($cuser);
# Translate pool ID
if (my $pid = $pidMap{$cpoolMember->{'PoolID'}}) {
$cpoolMember->{'PoolID'} = $pid;
# Process this pool member
if (!defined(my $pmid = createPoolMember($cpoolMember))) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to load pool member '%s'",$pmid);
}
} else {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to load pool member '%s', no pool ID map for '%s'",
$cpoolMember->{'Username'},
$cpoolMember->{'PoolID'}
);
}
}
}
# Write out statefile
sub _write_statefile
{
my $fullWrite = shift;
# We reset this early so we don't get triggred continuously if we encounter errors
$globals->{'StateChanged'} = 0;
$globals->{'LastStateSync'} = time();
# Check if the state file exists first of all
if (!defined($config->{'statefile'})) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] No statefile defined. Possible initial load error?");
return;
}
# Only write out if we actually have users, else we may of crashed?
if (keys %{$limits} < 1) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Not writing state file as there are no active users");
# 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;
}
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Saving statefile '%s'",$config->{'statefile'});
my $timer1 = [gettimeofday];
# Create new state file object
my $state = new Config::IniFiles();
# Loop with persistent users, these are users with expires = 0
foreach my $lid (keys %{$limits}) {
# Skip over expiring entries, we only want persistent ones
# XXX: Should we not just save all of them? load?
next if ($limits->{$lid}->{'Expires'});
# Pull in the section name
my $section = "persist " . $limits->{$lid}->{'Username'};
# 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;
}
# Add a new section for this user
# Create a section name
my $section = "interface_traffic_class.override " . $itcid;
# Add a section for this class override
$state->AddSection($section);
# Items we want for persistent entries
foreach my $pItem (LIMIT_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 = $limits->{$lid}->{$pItem})) {
$state->newval($section,$pItem,$value);
if (defined(my $value = $interfaceTrafficClass->{'.applied_overrides'}->{'change'}->{$attr})) {
$state->newval($section,$attr,$value);
}
}
}
# Loop with overrides
foreach my $username (keys %{$overrides}) {
# Pull in the section name
my $section = "override " . $username;
# Loop with pool overrides
while ((my $poid, my $poolOverride) = each(%{$globals->{'PoolOverrides'}})) {
# Create a section name
my $section = "pool.override " . $poid;
# Add a new section for this user
# Add a section for this pool override
$state->AddSection($section);
# Items we want for override entries
foreach my $pItem (OVERRIDE_PERSISTENT_ATTRIBUTES) {
# Attributes we want to save for this pool override
foreach my $attr (POOL_OVERRIDE_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $overrides->{$username}->{$pItem})) {
$state->newval($section,$pItem,$value);
if (defined(my $value = $globals->{'PoolOverrides'}->{$poid}->{$attr})) {
$state->newval($section,$attr,$value);
}
}
}
# Check for an error
if (!defined($state->WriteConfig($config->{'statefile'}))) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to write statefile '".$config->{'statefile'}."': $!");
return;
}
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] Configuration saved");
}
# Do the actual queue processing
sub _process_limit_change_queue
{
my $kernel = shift;
# Now
my $now = time();
#
# LOOP WITH CHANGES
#
foreach my $lid (keys %{$changeQueue}) {
# Changes for limit
# Minimum required info is:
# - Username
# - IP
# - Status
# - LastUpdate
my $climit = $changeQueue->{$lid};
#
# LIMIT IN LIST
#
if (defined(my $glimit = $limits->{$lid})) {
# This is a new limit notification
if ($climit->{'Status'} eq "new") {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Limit '$climit->{'Username'}' [$lid], limit already live but new state provided?");
# Get the changes we made and push them to the shaper
if (my $changes = _getLimitChangeset($glimit,$climit)) {
# Post to shaper
$kernel->post("shaper" => "change" => $lid => $changes);
}
# Remove from change queue
delete($changeQueue->{$lid});
# Online or "ping" status notification
} elsif ($climit->{'Status'} eq "online") {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Limit '$climit->{'Username'}' [$lid], limit still online");
# Get the changes we made and push them to the shaper
if (my $changes = _getLimitChangeset($glimit,$climit)) {
# Post to shaper
$kernel->post("shaper" => "change" => $lid => $changes);
}
# Remove from change queue
delete($changeQueue->{$lid});
# Offline notification, this we going to treat specially
} elsif ($climit->{'Status'} eq "offline") {
# We first check if this update was received some time ago, and if it exceeds our expire time
# We don't want to immediately remove a limit, only for him to come back on a few seconds later, the cost in exec()'s
# would be pretty high
if ($now - $climit->{'LastUpdate'} > TIMEOUT_EXPIRE_OFFLINE) {
# Remove entry if no longer live
if ($glimit->{'_shaper.state'} == SHAPER_NOTLIVE) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Limit '$climit->{'Username'}' [$lid] offline and removed from shaper");
# Remove from system
delete($limits->{$lid});
# Remove from change queue
delete($changeQueue->{$lid});
# Set this UID as no longer using this IP
# NK: If we try remove it before the limit is actually removed we could get a reconnection causing this value
# to be totally gone, which means we not tracking this limit using this IP anymore, not easily solved!!
delete($limitIPMap->{$glimit->{'IP'}}->{$lid});
# Check if we can delete the IP too
if (keys %{$limitIPMap->{$glimit->{'IP'}}} == 0) {
delete($limitIPMap->{$glimit->{'IP'}});
}
# Next record, we don't want to do any updates below
next;
# Push to shaper
} elsif ($glimit->{'_shaper.state'} == SHAPER_LIVE) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Limit '$climit->{'Username'}' [$lid] offline, queue remove from shaper");
# Loop with 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");
# Post removal to shaper
$kernel->post("shaper" => "remove" => $lid);
# Create a section name
my $section = "pool " . $pid;
} else {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Limit '$climit->{'Username'}' [$lid], limit in list, but offline now and".
" expired, still live, waiting for shaper");
}
}
# Add a section for this pool
$state->AddSection($section);
# Persistent attributes we want
foreach my $attr (POOL_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $pool->{$attr})) {
$state->newval($section,$attr,$value);
}
}
# Update the limit data
$glimit->{'Status'} = $climit->{'Status'};
$glimit->{'LastUpdate'} = $climit->{'LastUpdate'};
$glimit->{'Expires'} = $climit->{'Expires'};
# Set these if they exist
if (defined($climit->{'FriendlyName'})) {
$glimit->{'FriendlyName'} = $climit->{'FriendlyName'};
}
if (defined($climit->{'Notes'})) {
$glimit->{'Notes'} = $climit->{'Notes'};
}
# Save pool members too
foreach my $pmid (keys %{$globals->{'PoolMemberMap'}->{$pid}}) {
# Create a section name for the pool member
$section = "pool_member " . $pmid;
#
# LIMIT NOT IN LIST
#
} else {
# We take new and online notifications the same way here if the limit is not in our global limit list already
if (($climit->{'Status'} eq "new" || $climit->{'Status'} eq "online")) {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Processing new limit '$climit->{'Username'}' [$lid]");
# We first going to look for IP conflicts...
my @ipLimits = keys %{$limitIPMap->{$climit->{'IP'}}};
if (
# If there is already an entry and its not us ...
( @ipLimits == 1 && !defined($limitIPMap->{$climit->{'IP'}}->{$lid}) )
# Or if there is more than 1 entry...
|| @ipLimits > 1
) {
# We not going to post this to the shaper, but we are going to override the status
$climit->{'Status'} = 'conflict';
$climit->{'_shaper.state'} = SHAPER_NOTLIVE;
# Give a bit of info
my @conflictUsernames;
foreach my $lid (@ipLimits) {
push(@conflictUsernames,$limits->{$lid}->{'Username'});
}
# Output log line
$logger->log(LOG_WARN,"[CONFIGMANAGER] Cannot process limit '".$climit->{'Username'}."' IP '$climit->{'IP'}' conflicts with users '".
join(',',@conflictUsernames)."'.");
# We cannot trust shaping when there is more than 1 limit on the IP, so we going to remove all limits with this
# IP from the shaper below...
foreach my $lid2 (@ipLimits) {
# Check if the limit has been setup already (all but the limit we busy with, as its setup below)
if (defined($limitIPMap->{$climit->{'IP'}}->{$lid2})) {
my $glimit2 = $limits->{$lid2};
# If the limit is active or pending on the shaper, remove it
if ($glimit2->{'_shaper.state'} == SHAPER_LIVE || $glimit2->{'_shaper.state'} == SHAPER_PENDING) {
$logger->log(LOG_WARN,"[CONFIGMANAGER] Removing conflicted limit '".$glimit2->{'Username'}."' [$lid2] from shaper'");
# Post removal to shaper
$kernel->post("shaper" => "remove" => $lid2);
# Update that we're offline directly to global limit table
$glimit2->{'Status'} = 'conflict';
}
}
}
# Add a new section for this pool member
$state->AddSection($section);
# All looks good, no conflicts, we're set to add this limit!
} else {
# Post to the limit to the shaper
$climit->{'_shaper.state'} = SHAPER_PENDING;
$kernel->post("shaper" => "add" => $lid);
my $poolMember = $globals->{'PoolMembers'}->{$pmid};
# Items we want for persistent entries
foreach my $attr (POOLMEMBER_PERSISTENT_ATTRIBUTES) {
# Set items up
if (defined(my $value = $poolMember->{$attr})) {
$state->newval($section,$attr,$value);
}
# Set this UID as using this IP
$limitIPMap->{$climit->{'IP'}}->{$lid} = 1;
# This is now live
$limits->{$lid} = $climit;
# Limit is not in our list and this is an unknown state we're trasitioning to
} else {
$logger->log(LOG_DEBUG,"[CONFIGMANAGER] Ignoring limit '$climit->{'Username'}' [$lid] state '$climit->{'Status'}', not in our".
" global list");
}
# Remove from change queue
delete($changeQueue->{$lid});
}
}
# Check for an error
my $newFilename = $config->{'statefile'}.".new";
if (!defined($state->WriteConfig($newFilename))) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to write temporary statefile '%s': %s",$newFilename,$!);
return;
}
#
# CHECK OUT CONNECTED LIMITS
#
foreach my $lid (keys %{$limits}) {
# Global limit
my $glimit = $limits->{$lid};
# Check for expired limits
if ($glimit->{'Expires'} && $glimit->{'Expires'} < $now) {
$logger->log(LOG_INFO,"[CONFIGMANAGER] Limit '$glimit->{'Username'}' has expired, marking offline");
# Looks like this limit has expired?
my $climit = {
'Username' => $glimit->{'Username'},
'IP' => $glimit->{'IP'},
'Status' => 'offline',
'LastUpdate' => $glimit->{'LastUpdate'},
};
# Add to change queue
$changeQueue->{$lid} = $climit;
# If we have a state file, we going to rename it
my $bakFilename = $config->{'statefile'}.".bak";
if (-f $config->{'statefile'}) {
# Check if we could rename/move
if (!rename($config->{'statefile'},$bakFilename)) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to rename '%s' to '%s': %s",$config->{'statefile'},$bakFilename,$!);
return;
}
}
# Move the new filename in place
if (!rename($newFilename,$config->{'statefile'})) {
$logger->log(LOG_ERR,"[CONFIGMANAGER] Failed to rename '%s' to '%s': %s",$newFilename,$config->{'statefile'},$!);
return;
}
my $timer2 = [gettimeofday];
my $timediff2 = tv_interval($timer1,$timer2);
$logger->log(LOG_NOTICE,"[CONFIGMANAGER] State file '%s' saved in %s",$config->{'statefile'},sprintf('%.3fs',$timediff2));
}
1;
# vim: ts=4
opentrafficshaper/plugins/radius/radius.pm
View file @ efc9ebe1
# OpenTrafficShaper radius module
# 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -29,7 +29,26 @@ use POE;
use IO::Socket::INET;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use awitpt::util;
use opentrafficshaper::plugins::configmanager qw(
createPool
changePool
createPoolMember
changePoolMember
createLimit
getPoolByName
getPoolMember
getPoolMembers
getPoolMemberByUsernameIP
isInterfaceGroupIDValid
isTrafficClassIDValid
isMatchPriorityIDValid
isGroupIDValid
);
# Exporter stuff
......@@ -42,9 +61,15 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.0.1',
VERSION => '1.0.0',
DATAGRAM_MAXLEN => 8192,
DEFAULT_EXPIRY_PERIOD => 86400,
# Expirty period for removal of entries
REMOVE_EXPIRY_PERIOD => 60,
# IANA public enterprise number
# This is used as the radius vendor code
IANA_PEN => 42109,
......@@ -55,44 +80,56 @@ use constant {
our $pluginInfo = {
Name => "Radius",
Version => VERSION,
Init => \&plugin_init,
Start => \&plugin_start,
};
# 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
'expiry_period' => DEFAULT_EXPIRY_PERIOD,
'username_to_pool_transform' => undef,
'interface_group' => 'eth1,eth0',
'match_priority' => 2,
'traffic_class' => 2,
'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);
$logger->log(LOG_NOTICE,"[RADIUS] OpenTrafficShaper Radius Module v".VERSION." - Copyright (c) 2013, AllWorldIT");
# 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);
}
......@@ -103,28 +140,75 @@ sub plugin_init
foreach my $df (@{$config->{'config.dictionaries'}}) {
# Load dictionary
if ($dict->readfile($df)) {
$logger->log(LOG_INFO,"[RADIUS] Loaded dictionary '$df'.");
$logger->log(LOG_INFO,"[RADIUS] Loaded dictionary '%s'",$df);
} else {
$logger->log(LOG_WARN,"[RADIUS] Failed to load dictionary '$df': $!");
$logger->log(LOG_WARN,"[RADIUS] Failed to load dictionary '%s': %s",$df,$!);
}
}
$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'})) {
$logger->log(LOG_INFO,"[RADIUS] Set expiry_period to '$expiry'");
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 = $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 = $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;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'interface_group' as value '%s' is invalid",$interfaceGroup);
}
} else {
$logger->log(LOG_INFO,"[RADIUS] Using default interface_group '%s'",$config->{'interface_group'});
}
# Default match priority to use
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;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'match_priority' as value '%s' is invalid",$matchPriority);
}
}
# Default traffic class to use
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;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'traffic_class' as value '%s' is invalid",$trafficClassID);
}
}
# Default group to use
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;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'group' as value '%s' is invalid",$group);
}
}
# Radius listener
POE::Session->create(
inline_states => {
_start => \&session_start,
_stop => \&session_stop,
get_datagram => \&session_read,
_start => \&_session_start,
_stop => \&_session_stop,
_socket_read => \&_session_socket_read,
}
);
......@@ -132,6 +216,7 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
......@@ -141,34 +226,39 @@ sub plugin_start
# Initialize server
sub session_start
sub _session_start
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# Create socket for radius
if (!defined($heap->{'socket'} = IO::Socket::INET->new(
Proto => 'udp',
Proto => 'udp',
# TODO - Add to config file
# LocalAddr => '192.168.254.2',
LocalPort => '1813',
))) {
$logger->log(LOG_ERR,"Failed to create Radius listening socket: $!");
$logger->log(LOG_ERR,"Failed to create Radius listening socket: %s",$!);
return;
}
# Set our alias
$kernel->alias_set("plugin.radius");
# Setup our reader
$kernel->select_read($heap->{'socket'}, "get_datagram");
# Setup our socket reader event
$kernel->select_read($heap->{'socket'}, "_socket_read");
$logger->log(LOG_DEBUG,"[RADIUS] Initialized");
}
# Shut down server
sub session_stop
sub _session_stop
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# Tear down the socket select
if (defined($heap->{'socket'})) {
$kernel->select_read($heap->{'socket'},undef);
......@@ -176,7 +266,6 @@ sub session_stop
# Blow everything away
$globals = undef;
$dictionary = undef;
$logger->log(LOG_DEBUG,"[RADIUS] Shutdown");
......@@ -184,25 +273,30 @@ sub session_stop
}
# Read event for server
sub session_read
sub _session_socket_read
{
my ($kernel, $socket) = @_[KERNEL, ARG0];
# Read in packet from the socket
my $peer = recv($socket, my $udp_packet = "", DATAGRAM_MAXLEN, 0);
# If we don't have a peer, just return
return unless defined $peer;
if (!defined($peer)) {
$logger->log(LOG_WARN,"[RADIUS] Peer appears to be undefined");
return;
}
# Get peer port and addy from remote host
my ($peer_port, $peer_addr) = unpack_sockaddr_in($peer);
my $peer_addr_h = inet_ntoa($peer_addr);
# Parse packet
my $pkt = new opentrafficshaper::plugins::radius::Radius::Packet($dictionary,$udp_packet);
my $pkt = opentrafficshaper::plugins::radius::Radius::Packet->new($globals->{'Dictionary'},$udp_packet);
# Build log line
my $logLine = sprintf("Remote: $peer_addr_h, Code: %s, Identifier: %s => ",$pkt->code,$pkt->identifier);
my $logLine = sprintf("Remote: %s:%s, Code: %s, Identifier: %s => ",$peer_addr_h,$peer_port,$pkt->code,$pkt->identifier);
foreach my $attr ($pkt->attributes) {
$logLine .= sprintf(" %s: '%s',", $attr, $pkt->rawattr($attr));
}
......@@ -225,7 +319,7 @@ sub session_read
$logLine .= sprintf(" %s/%s: %s,",$vendor,$attr,$attrVal);
}
}
$logger->log(LOG_DEBUG,"[RADIUS] $logLine");
$logger->log(LOG_DEBUG,"[RADIUS] %s",$logLine);
# TODO - verify packet
......@@ -235,74 +329,307 @@ sub session_read
# Pull in a variables from packet
my $username = $pkt->rawattr("User-Name");
my $trafficGroup;
my $group = $config->{'group'};
if (my $attrRawVal = $pkt->vsattr(IANA_PEN,'OpenTrafficShaper-Traffic-Group')) {
$trafficGroup = @{ $attrRawVal }[0];
my $var = @{ $attrRawVal }[0];
# Next check if its valid
if (isGroupIDValid($var)) {
$group = $var;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'group' for user '%s' as value '%s' is invalid, using default '%s'",
$username,
$var,
$group
);
}
}
my $trafficClass;
my $trafficClassID = $config->{'traffic_class'};
if (my $attrRawVal = $pkt->vsattr(IANA_PEN,'OpenTrafficShaper-Traffic-Class')) {
$trafficClass = @{ $attrRawVal }[0];
my $var = @{ $attrRawVal }[0];
# Check if its valid
if (isTrafficClassIDValid($var)) {
$trafficClassID = $var;
} else {
$logger->log(LOG_WARN,"[RADIUS] Cannot set 'traffic_class' for user '%s' as value '%s' is invalid, using default '%s'",
$username,
$var,
$trafficClassID
);
}
}
my $trafficLimit;
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)) {
my ($trafficLimitRxQuantifier,$trafficLimitTxQuantifier);
my ($trafficLimitRxBurstQuantifier,$trafficLimitTxBurstQuantifier);
# 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);
# 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;
}
# Set default if they undefined
if (!defined($trafficGroup)) {
$trafficGroup = 1;
# Check if we have a pool transform
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'}) {
$poolName = $1;
}
}
if (!defined($trafficClass)) {
$trafficClass = 1;
# Check if the pool name is being overridden
if (my $attrRawVal = $pkt->vsattr(IANA_PEN,'OpenTrafficShaper-Traffic-Pool')) {
$poolName = @{ $attrRawVal }[0];
}
# If we don't have rate limits, short circuit
if (!defined($trafficLimitTx)) {
return;
# 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;
}
if (!defined($trafficLimitRx)) {
return;
# Try grab the pool
my $pool = getPoolByName($config->{'interface_group'},$poolName);
my $pid = defined($pool) ? $pool->{'ID'} : undef;
my $ipAddress = $pkt->attr('Framed-IP-Address');
my $statusType = getStatus($pkt->rawattr('Acct-Status-Type'));
$logger->log(LOG_INFO,"[RADIUS] Status: %s, User: %s, IP: %s, InterfaceGroup: %s, MatchPriorityID: %s, Group: %s, Class: %s, ".
"CIR: %s/%s, Limit: %s/%s",
$statusType,
$username,
$ipAddress,
$config->{'interface_group'},
$config->{'match_priority'},
$group,
$trafficClassID,
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
# Check if user is new or online
if ($statusType eq "new" || $statusType eq "online") {
# Check if pool is defined
if (defined($pool)) {
my @poolMembers = getPoolMembers($pid);
# Check if we created the pool
if ($pool->{'Source'} eq "plugin.radius") {
# Make sure the pool is 0 or 1
if (@poolMembers < 2) {
# Change the details
my $changes = changePool({
'ID' => $pid,
'FriendlyName' => $ipAddress,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'RxCIR' => $rxCIR,
# These MUST be defined
'TxLimit' => $txLimit,
'RxLimit' => $rxLimit,
'Expires' => $now + DEFAULT_EXPIRY_PERIOD
});
my @txtChanges;
foreach my $item (keys %{$changes}) {
# Make expires look nice
my $value = $changes->{$item};
if ($item eq "Expires") {
$value = sprintf("%s [%s]",$value,scalar(localtime($value)));
}
push(@txtChanges,sprintf("%s = %s",$item,$value));
}
if (@txtChanges) {
$logger->log(LOG_INFO,"[RADIUS] Pool '%s' updated: %s",$poolName,join(", ",@txtChanges));
}
# If we do have more than 1 member, make a note of it
} else {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has more than 1 member, not updating",$poolName);
}
}
# No pool, time to create one
} else {
# If we don't have rate limits, short circuit
if (!defined($txCIR)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'TxCIR', aborting",$poolName);
return;
}
if (!defined($rxCIR)) {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' has no 'RxCIR', aborting",$poolName);
return;
}
# Create pool
$pid = createPool({
'FriendlyName' => $ipAddress,
'Name' => $poolName,
'InterfaceGroupID' => $config->{'interface_group'},
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'RxCIR' => $rxCIR,
'TxLimit' => $txLimit,
'RxLimit' => $rxLimit,
'Expires' => $now + $config->{'expiry_period'},
'Source' => "plugin.radius",
});
if (!defined($pid)) {
$logger->log(LOG_WARN,"[RADIUS] Pool '%s' failed to create, aborting",$poolName);
return;
}
}
# If we have a pool member
if (defined(my $pmid = getPoolMemberByUsernameIP($pid,$username,$ipAddress))) {
my $poolMember = getPoolMember($pmid);
# Check if we created the pool member
if ($poolMember->{'Source'} eq "plugin.radius") {
my $changes = changePoolMember({
'ID' => $poolMember->{'ID'},
'Expires' => $now + DEFAULT_EXPIRY_PERIOD
});
my @txtChanges;
foreach my $item (keys %{$changes}) {
# Make expires look nice
my $value = $changes->{$item};
if ($item eq "Expires") {
$value = sprintf("%s [%s]",$value,scalar(localtime($value)));
}
push(@txtChanges,sprintf("%s = %s",$item,$value));
}
if (@txtChanges) {
$logger->log(LOG_INFO,"[RADIUS] Pool '%s' member '%s' updated: %s",
$poolName,
$username,
join(", ",@txtChanges)
);
}
# TODO: Add output of updated items here too?
changePool({
'ID' => $pid,
'FriendlyName' => $ipAddress
});
# If not display message
} else {
$logger->log(LOG_NOTICE,"[RADIUS] Pool '%s' member '%s' update ignored as it was not added by 'plugin.radius'",
$poolName,
$username
);
}
# We have a pool but no member...
} else {
createPoolMember({
'FriendlyName' => $username,
'Username' => $username,
'IPAddress' => $ipAddress,
'InterfaceGroupID' => $config->{'interface_group'},
'MatchPriorityID' => $config->{'match_priority'},
'PoolID' => $pid,
'GroupID' => $group,
'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
} elsif ($statusType eq "offline") {
# Check if we have a pool
if (defined($pool)) {
# Grab pool members
my @poolMembers = getPoolMembers($pool->{'ID'});
# If this is ours we can set the expires to "queue" removal
if ($pool->{'Source'} eq "plugin.radius") {
# 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({
'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({
'ID' => $pmid,
'Expires' => $now + REMOVE_EXPIRY_PERIOD
});
}
$logger->log(LOG_INFO,"[RADIUS] Pool '$poolName' member '$username' set to expire as they're offline");
# No pool
} else {
$logger->log(LOG_DEBUG,"[RADIUS] Pool '$poolName' member '$username' doesn't exist went offline");
}
} else {
$logger->log(LOG_WARN,"[RADIUS] Unknown radius code '%s' for pool '%s' member '%s'",$pkt->code,$poolName,$username);
}
# Build user
my $user = {
'Username' => $username,
'IP' => $pkt->attr('Framed-IP-Address'),
'GroupID' => $trafficGroup,
'ClassID' => $trafficClass,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'Expires' => $now + (defined($globals->{'file.config'}->{'plugin.radius'}->{'expire_entries'}) ?
$globals->{'file.config'}->{'plugin.radius'}->{'expire_entries'} : $config->{'expiry_period'}),
'Status' => getStatus($pkt->rawattr('Acct-Status-Type')),
'Source' => "plugin.radius",
};
# Throw the change at the config manager
$kernel->post("configmanager" => "process_change" => $user);
$logger->log(LOG_INFO,"[RADIUS] Code: $user->{'Status'}, User: $user->{'Username'}, IP: $user->{'IP'}, Group: $user->{'GroupID'}, Class: $user->{'ClassID'}, ".
"Limits: ".prettyUndef($trafficLimitTx)."/".prettyUndef($trafficLimitRx).", Burst: ".prettyUndef($trafficLimitTxBurst)."/".prettyUndef($trafficLimitRxBurst));
}
# Convert status into something easy to useful
sub getStatus
{
......@@ -321,17 +648,16 @@ 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;
......@@ -341,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-2013, 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -21,41 +21,155 @@ package opentrafficshaper::plugins::statistics;
use strict;
use warnings;
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( getLimits );
use opentrafficshaper::plugins::configmanager qw(
getPool
getPools
getPoolMembers
getPoolTxInterface
getPoolRxInterface
getPoolTrafficClassID
getTrafficClasses
getAllTrafficClasses
);
# NK: TODO: Maybe we want to remove timing at some stage? maybe not?
use Time::HiRes qw( gettimeofday tv_interval );
# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
STATISTICS_PERIOD
STATISTICS_DIR_TX
STATISTICS_DIR_RX
);
@EXPORT_OK = qw(
getLastStats
getLastStats
getStatsBySID
getStatsBasicBySID
getSIDFromCID
getSIDFromPID
);
use constant {
VERSION => '0.0.1',
VERSION => '0.2.2',
# How often our config check ticks
TICK_PERIOD => 2,
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 = {
Name => "Statistics Interface",
Version => VERSION,
Init => \&plugin_init,
Start => \&plugin_start,
# Signals
signal_SIGHUP => \&handle_SIGHUP,
};
......@@ -64,18 +178,29 @@ my $globals;
my $logger;
# Our configuration
my $config = {
'dsn_name' => "dbi:SQLite:dbname=/tmp/statsfile.sqlite",
'dsn_user' => "",
'dsn_pass' => "",
};
# Handle of DBI
#
# $globals->{'Database'}->{'Handle'}
# $globals->{'Database'}->{'DSN'}
# $globals->{'Database'}->{'Username'}
# $globals->{'Database'}->{'Password'}
# DB identifier map
#
# $globals->{'IdentifierMap'}
# Stats queue
#
# $globals->{'StatsQueue'}
# $globals->{'LastCleanup'}
# $globals->{'LastConfigManagerStats'}
# Stats subscribers & counter
# $globals->{'SIDSubscribers'}
# $globals->{'SSIDMap'}
# $globals->{'SSIDCounter'}
# $globals->{'SSIDCounterFreeList'}
# Stats cache
my $statsCache = {};
# Stats subscribers
my $subscribers;
# $subscribers => $user => [ { 'session' => 'event' }, { 'session' , 'event' } ]
# Initialize plugin
......@@ -87,173 +212,1152 @@ sub plugin_init
# Setup our environment
$logger = $globals->{'logger'};
$logger->log(LOG_NOTICE,"[STATISTICS] OpenTrafficShaper Statistics v".VERSION." - Copyright (c) 2013, AllWorldIT");
$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 $dsnn = $globals->{'file.config'}->{'plugin.STATISTICS'}->{'dsn_name'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set dsn_name to '$dsnn'");
$config->{'dsn_name'} = $dsnn;
}
if (defined(my $dsnu = $globals->{'file.config'}->{'plugin.STATISTICS'}->{'dsn_user'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set dsn_user to '$dsnu'");
$config->{'dsn_user'} = $dsnu;
}
if (defined(my $dsnp = $globals->{'file.config'}->{'plugin.STATISTICS'}->{'dsn_pass'})) {
$logger->log(LOG_INFO,"[STATISTICS] Set dsn_pass to '$dsnp'");
$config->{'dsn_pass'} = $dsnp;
}
if (defined(my $dbdsn = $globals->{'file.config'}->{'plugin.statistics'}->{'db_dsn'})) {
$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 database DSN to specified in configuration file. Stats storage disabled!");
}
# This session is our main session, its alias is "shaper"
# This is our main stats session
POE::Session->create(
inline_states => {
_start => \&session_init,
_start => \&_session_start,
_stop => \&_session_stop,
_tick => \&_session_tick,
# Stats update event
update => \&do_update,
# Subscription events
subscribe => \&do_subscribe,
unsubscribe => \&do_unsubscribe,
update => \&_session_update,
}
);
# Create DBI agent
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 initailize database: %s (DATABASE DISABLED)",
awitpt::db::dblayer::Error());
}
# Set last cleanup to now
my $now = time();
foreach my $key (keys %{STATS_CONFIG()}) {
# Get aligned time so we cleanup sooner
$globals->{'LastCleanup'}->{$key} = _getAlignedTime($now,STATS_CONFIG()->{$key}->{'precision'});
}
$globals->{'LastConfigManagerStats'} = $now;
}
return 1;
}
# Start the plugin
sub plugin_start
{
$logger->log(LOG_INFO,"[STATISTICS] Started");
}
# Initialize this plugins main POE session
sub session_init {
my $kernel = $_[KERNEL];
sub _session_start
{
my ($kernel,$heap) = @_[KERNEL, HEAP];
# Set our alias
$kernel->alias_set("statistics");
# Set delay on config updates
$kernel->delay('_tick' => TICK_PERIOD);
$logger->log(LOG_DEBUG,"[STATISTICS] Initialized");
}
# Update limit Statistics
# $uid has some special use cases:
# main:$iface:all - Interface total stats
# main:$iface:classes - Interface classified traffic
# main:$iface:besteffort - Interface best effort traffic
sub do_update {
my ($kernel, $item, $stats) = @_[KERNEL, ARG0, ARG1];
# Buffer size
$logger->log(LOG_INFO,"[STATISTICS] Statistics update for '%s', buffered '%s' items",$item,scalar keys %{$statsCache->{$item}});
# Stop session
sub _session_stop
{
my ($kernel,$heap) = @_[KERNEL, HEAP];
if ($item =~ /^main/) {
} else {
# Pull in global
my $limits = getLimits();
my $limit = $limits->{$item};
my $username = $limit->{'Username'};
# Save entry
$statsCache->{$username}->{$stats->{'timestamp'}}->{$stats->{'direction'}} = $stats;
use Data::Dumper; print STDERR "Limit: ".Dumper($limit);
use Data::Dumper; print STDERR "Stats: ".Dumper($stats);
}
# Check if we have an event handler subscriber for this item
if (defined($subscribers->{$item}) && %{$subscribers->{$item}}) {
print STDERR "Pass1\n";
# If we do, loop with them
foreach my $handler (keys %{$subscribers->{$item}}) {
print STDERR "Pass2: $handler\n";
# If no events are linked to this handler, continue
if (!(keys %{$subscribers->{$item}->{$handler}})) {
print STDERR "Pass3: $handler\n";
next;
# Remove our alias
$kernel->alias_remove("statistics");
# Tear down data
$globals = undef;
$logger->log(LOG_DEBUG,"[STATISTICS] Shutdown");
$logger = undef;
}
# Time ticker for processing changes
sub _session_tick
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# If we don't have a database, just skip...
if (!$globals->{'Database'}) {
return;
}
my $now = time();
my $timer1 = [gettimeofday];
# Even out flushing over 10s to absorb spikes
my $totalFlush = @{$globals->{'StatsQueue'}};
my $maxFlush = int($totalFlush / 10) + 100;
my $numFlush = 0;
# Make sure we don't write more than 10k entries per pass
if ($maxFlush > STATISTICS_MAXFLUSH_PER_PERIOD) {
$maxFlush = STATISTICS_MAXFLUSH_PER_PERIOD;
}
# Loop and build the data to create our multi-insert
my (@insertHolders,@insertBasicHolders);
my (@insertData,@insertBasicData);
while (defined(my $stat = shift(@{$globals->{'StatsQueue'}})) && $numFlush < $maxFlush) {
# This is a basic counter
if (defined($stat->{'Counter'})) {
push(@insertBasicHolders,"(?,?,?,?)");
push(@insertBasicData,
$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->{'QueueLen'},
$stat->{'TotalBytes'}, $stat->{'TotalPackets'}, $stat->{'TotalOverLimits'}, $stat->{'TotalDropped'}
);
}
$numFlush++;
}
# If we got things to insert, do it
if (@insertBasicHolders > 0) {
my $res = DBDo('
INSERT INTO stats_basic
(
`IdentifierID`, `Key`, `Timestamp`,
`Counter`
)
VALUES
'.join(',',@insertBasicHolders),@insertBasicData
);
# Check for error
if (!defined($res)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic insert: %s",awitpt::db::dblayer::Error());
}
}
# And normal stats...
if (@insertHolders > 0) {
my $res = DBDo('
INSERT INTO stats
(
`IdentifierID`, `Key`, `Timestamp`,
`Direction`,
`CIR`, `Limit`, `Rate`, `PPS`, `QueueLen`,
`TotalBytes`, `TotalPackets`, `TotalOverLimits`, `TotalDropped`
)
VALUES
'.join(',',@insertHolders),@insertData
);
# Check for error
if (!defined($res)) {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats insert: %s",awitpt::db::dblayer::Error());
}
}
my $timer2 = [gettimeofday];
# We only need stats if we did something, right?
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)
);
}
my $res;
# Loop with our stats consolidation configuration
foreach my $key (sort keys %{STATS_CONFIG()}) {
my $timerA = [gettimeofday];
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 ($globals->{'LastCleanup'}->{$key} > $lastPeriod) {
next;
}
# Stats
my $numStatsBasicConsolidated = 0;
my $numStatsConsolidated = 0;
my $consolidateFrom = $lastPeriod - $precision * 2;
my $consolidateUpTo = $lastPeriod - $precision;
# Execute and pull in consolidated stats
$res = DBSelect(SQL_CONSOLIDATE_STATS_BASIC,$precision,$prevKey,$consolidateFrom,$consolidateUpTo);
if ($res) {
# Loop with items returned
while (my $item = hashifyLCtoMC($res->fetchrow_hashref(),'IdentifierID','Timestamp','Counter')) {
$item->{'Key'} = $key;
# Queue for insert
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",
awitpt::db::dblayer::Error());
}
# And the normal stats...
$res = DBSelect(SQL_CONSOLIDATE_STATS,$precision,$prevKey,$consolidateFrom,$consolidateUpTo);
if ($res) {
# Loop with items returned
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(@{$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",
awitpt::db::dblayer::Error());
}
# Or ... If we have events, process them
foreach my $event (keys %{$subscribers->{$item}->{$handler}}) {
print STDERR "Pass4: $event\n";
# Set last cleanup to 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))
);
}
$kernel->post($handler => $event => $item => $stats);
# Setup another timer
my $timer3 = [gettimeofday];
# 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($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 - (STATS_CONFIG()->{1}->{'precision'} * 3);
# Streamed stats is removed 3 time periods past the first precision
my $timerA = [gettimeofday];
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)),
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic cleanup statement: %s",
awitpt::db::dblayer::Error());
}
# And the normal stats...
$timerA = [gettimeofday];
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))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats cleanup statement: %s",
awitpt::db::dblayer::Error()
);
}
# Loop and remove retained stats
foreach my $key (keys %{STATS_CONFIG()}) {
# Work out timestamp to clean up to by multiplying the retention period by days
$cleanUpTo = $now - (STATS_CONFIG()->{$key}->{'retention'} * 86400);
# Retention period is in # days
my $timerA = [gettimeofday];
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))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats_basic cleanup statement for key %s: %s",
$key,
awitpt::db::dblayer::Error()
);
}
# And normal stats...
$timerA = [gettimeofday];
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))
);
}
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to execute stats cleanup statement for key %s: %s",
$key,
awitpt::db::dblayer::Error()
);
}
}
# Set last main cleanup to 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)
);
}
# Check if we need to pull config manager stats
if ($now - $globals->{'LastConfigManagerStats'} > STATISTICS_PERIOD) {
my $configManagerStats = _getConfigManagerStats();
_processStatistics($kernel,$configManagerStats);
$globals->{'LastConfigManagerStats'} = $now;
}
# Set delay on config updates
$kernel->delay('_tick' => TICK_PERIOD);
}
# Update limit Statistics
# $item has some special use cases:
# main:$iface:all - Interface total stats
# main:$iface:classes - Interface classified traffic
# main:$iface:besteffort - Interface best effort traffic
sub _session_update
{
my ($kernel, $statsData) = @_[KERNEL, ARG0];
_processStatistics($kernel,$statsData);
}
# Handle subscriptions to updates
sub do_subscribe
sub subscribe
{
my ($kernel, $handler, $handlerEvent, $item) = @_[KERNEL, ARG0, ARG1, ARG2];
my ($sid,$conversions,$handler,$event) = @_;
$logger->log(LOG_INFO,"[STATISTICS] Got subscription request for '%s': handler='%s', event='%s'",
$sid,
$handler,
$event
);
$logger->log(LOG_INFO,"[STATISTICS] Got subscription request from '$handler' for '$item' via event '$handlerEvent'");
# Grab next SSID
my $ssid = shift(@{$globals->{'SSIDCounterFreeList'}});
if (!defined($ssid)) {
$ssid = $globals->{'SSIDCounter'}++;
}
$subscribers->{$item}->{$handler}->{$handlerEvent} = $item;
# Setup data and conversions
$globals->{'SSIDMap'}->{$ssid} = $globals->{'SIDSubscribers'}->{$sid}->{$ssid} = {
'SID' => $sid,
'SSID' => $ssid,
'Conversions' => $conversions,
'Handler' => $handler,
'Event' => $event
};
# Return the SID we subscribed
return $ssid;
}
# Handle unsubscribes
sub do_unsubscribe
sub unsubscribe
{
my ($kernel, $handler, $handlerEvent, $item) = @_[KERNEL, ARG0, ARG1, ARG2];
my $ssid = shift;
$logger->log(LOG_INFO,"[STATISTICS] Got unsubscription request for '$handler' regarding '$item'");
# Grab item, and check if it doesnt exist
my $item = $globals->{'SSIDMap'}->{$ssid};
if (!defined($item)) {
$logger->log(LOG_ERR,"[STATISTICS] Got unsubscription request for SSID '%s' that doesn't exist",
$ssid
);
return
}
$logger->log(LOG_INFO,"[STATISTICS] Got unsubscription request for SSID '%s'",
$ssid
);
delete($subscribers->{$item}->{$handler}->{$handlerEvent});
# Remove subscriber
delete($globals->{'SIDSubscribers'}->{$item->{'SID'}}->{$ssid});
# If SID is now empty, remove it too
if (! keys %{$globals->{'SIDSubscribers'}->{$item->{'SID'}}}) {
delete($globals->{'SIDSubscribers'}->{$item->{'SID'}});
}
# Remove mapping
delete($globals->{'SSIDMap'}->{$ssid});
# Push onto list of free ID's
push(@{$globals->{'SSIDCounterFreeList'}},$ssid);
}
# Return user last stats
sub getLastStats
{
my $username = shift;
my $lid = shift;
my $statistics;
# Do we have stats for this user in the cache?
if (defined($statsCache->{$username})) {
# Grab last entry
my $lastTimestamp = (sort keys %{$statsCache->{$username}})[-1];
# We should ALWAYS have one, unless the server just booted
if (defined($lastTimestamp)) {
# Loop with both directions
foreach my $direction ('tx','rx') {
# Get a easier to use handle on the stats
if (my $stats = $statsCache->{$username}->{$lastTimestamp}->{$direction}) {
# Setup the statistics hash
$statistics->{$direction} = {
'current_rate' => $stats->{'current_rate'},
'current_pps' => $stats->{'current_pps'},
};
# # Do we have stats for this user in the cache?
# if (defined($statsCache->{$lid})) {
# # Grab last entry
# my $lastTimestamp = (sort keys %{$statsCache->{$lid}})[-1];
# # We should ALWAYS have one, unless the server just booted
# if (defined($lastTimestamp)) {
# # Loop with both directions
# foreach my $direction ('tx','rx') {
# # Get a easier to use handle on the stats
# if (my $stats = $statsCache->{$lid}->{$lastTimestamp}->{$direction}) {
# # Setup the statistics hash
# $statistics->{$direction} = {
# 'current_rate' => $stats->{'current_rate'},
# 'current_pps' => $stats->{'current_pps'},
# };
# }
# }
# }
# }
return $statistics;
}
# Return stats by SID
sub getStatsBySID
{
my ($sid,$conversions,$startTimestamp,$endTimestamp) = @_;
my $statistics = _getStatsBySID($sid,$startTimestamp,$endTimestamp);
if (!defined($statistics)) {
return;
}
# Loop and convert
foreach my $timestamp (keys %{$statistics}) {
my $stat = $statistics->{$timestamp};
# Use new item
$statistics->{$timestamp} = _fixStatDirection($stat,$conversions);
}
return $statistics;
}
# Return basic stats by SID
sub getStatsBasicBySID
{
my ($sid,$conversions) = @_;
my $statistics = _getStatsBasicBySID($sid);
if (!defined($statistics)) {
return;
}
# Loop and convert
foreach my $timestamp (keys %{$statistics}) {
my $stat = $statistics->{$timestamp};
# Use new item
$statistics->{$timestamp} = _fixCounterName($stat,$conversions);
}
return $statistics;
}
# Get the stats ID from Class ID
sub getSIDFromCID
{
my ($iface,$cid) = @_;
# Grab identifier based on class ID
my $identifier = _getIdentifierFromCID($iface,$cid);
if (!defined($identifier)) {
return;
}
# Return the SID fo the identifier
return _getSIDFromIdentifier($identifier);
}
# Set the stats ID from Class ID
sub setSIDFromCID
{
my ($iface,$cid) = @_;
# See if we can get a SID from the CID
my $sid = getSIDFromCID($iface,$cid);
if (!defined($sid)) {
# If not, grab the identifier
my $identifier = _getIdentifierFromCID($iface,$cid);
if (!defined($identifier)) {
return;
}
# And setup a new SID
$sid = _setSIDFromIdentifier($identifier);
}
return $sid;
}
# Get the stats ID from a PID
sub getSIDFromPID
{
my $pid = shift;
# Grab identifier from a PID
my $identifier = _getIdentifierFromPID($pid);
if (!defined($identifier)) {
return;
}
# Return the SID for the PID
return _getSIDFromIdentifier($identifier);
}
# Set the stats ID from a PID
sub setSIDFromPID
{
my $pid = shift;
# Try grab the SID for the PID
my $sid = getSIDFromPID($pid);
if (!defined($sid)) {
# If we can't, grab the identifier instead
my $identifier = _getIdentifierFromPID($pid);
if (!defined($identifier)) {
return;
}
# And setup the SID
$sid = _setSIDFromIdentifier($identifier);
}
return $sid;
}
# Get the stats ID from a counter
sub getSIDFromCounter
{
my $counter = shift;
# Grab identifier from a counter
my $identifier = _getIdentifierFromCounter($counter);
if (!defined($identifier)) {
return;
}
# Return the SID for the counter
return _getSIDFromIdentifier($identifier);
}
# Set the stats ID from a counter
sub setSIDFromCounter
{
my $counter = shift;
# Try grab the SID for the counter
my $sid = getSIDFromCounter($counter);
if (!defined($sid)) {
# If we can't, grab the identifier instead
my $identifier = _getIdentifierFromCounter($counter);
if (!defined($identifier)) {
return;
}
# And setup the SID
$sid = _setSIDFromIdentifier($identifier);
}
return $sid;
}
# Return traffic direction
sub getTrafficDirection
{
my ($pid,$interface) = @_;
# Grab the interfaces for this limit
my $txInterface = getPoolTxInterface($pid);
my $rxInterface = getPoolRxInterface($pid);
# Check what it matches...
if ($interface eq $txInterface) {
return STATISTICS_DIR_TX;
} elsif ($interface eq $rxInterface) {
return STATISTICS_DIR_RX;
}
return;
}
# Generate ConfigManager counters
sub getConfigManagerCounters
{
my @poolList = getPools();
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 (@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);
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;
}
#
# Internal Functions
#
# Function to process a bunch of statistics
sub _processStatistics
{
my ($kernel,$statsData) = @_;
my $queuedEvents;
# Loop through stats data we got
while ((my $sid, my $stat) = each(%{$statsData})) {
$stat->{'IdentifierID'} = $sid;
$stat->{'Key'} = 0;
# Add to main queue
push(@{$globals->{'StatsQueue'}},$stat);
# Check if we have an event handler subscriber for this item
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'})) {
$eventStat = {
'counter' => $stat->{'Counter'}
};
} else {
$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'};
# Get temp stat, this still refs the original one
my $tempStat;
# This is a basic counter
if (defined($eventStat->{'counter'})) {
$tempStat = _fixCounterName($eventStat,$conversions);
} else {
$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);
}
}
}
# Loop with events we need to dispatch
foreach my $handler (keys %{$queuedEvents}) {
my $events = $queuedEvents->{$handler};
foreach my $event (keys %{$events}) {
$kernel->post($handler => $event => $queuedEvents->{$handler}->{$event});
}
}
}
# Generate ConfigManager stats
sub _getConfigManagerStats
{
my $counters = getConfigManagerCounters();
my $now = time();
my $statsData = { };
# Loop through counters and create stats items
foreach my $item (keys %{$counters}) {
my $identifierID = setSIDFromCounter($item);
my $stat = {
'IdentifierID' => $identifierID,
'Timestamp' => $now,
'Counter' => $counters->{$item}
};
$statsData->{$identifierID} = $stat;
}
return $statsData;
}
# Function to get a SID identifier from a class ID
sub _getIdentifierFromCID
{
my ($iface,$cid) = @_;
return sprintf("Class:%s:%s",$iface,$cid);
}
# Function to get a SID identifier from a pool ID
sub _getIdentifierFromPID
{
my $pid = shift;
my $pool = getPool($pid);
if (!defined($pool)) {
return;
}
return sprintf("Pool:%s/%s",$pool->{'InterfaceGroupID'},$pool->{'Name'});
}
# Function to get a SID identifier from a counter
sub _getIdentifierFromCounter
{
my $counter = shift;
return sprintf("Counter:%s",$counter);
}
# Return a cached SID if its cached
sub _getCachedSIDFromIdentifier
{
my $identifier = shift;
return $globals->{'IdentifierMap'}->{$identifier};
}
# Grab or add the identifier to the DB
sub _getSIDFromIdentifier
{
my $identifier = shift;
# Check if we have it cached
if (my $sid = _getCachedSIDFromIdentifier($identifier)) {
return $sid;
}
# We need the DB to be alive to do this...
if (!defined($globals->{'Database'})) {
return;
}
# Try grab it from DB
if (my $res = DBSelect(SQL_GET_IDENTIFIER,$identifier)) {
# Grab first row and return
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,awitpt::db::dblayer::Error());
}
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
if (my $res = DBDo(SQL_ADD_IDENTIFIER,$identifier)) {
return $globals->{'IdentifierMap'}->{$identifier} = DBLastInsertID("","");
} else {
$logger->log(LOG_ERR,"[STATISTICS] Failed to set SID from identifier '%s': %s",$identifier,awitpt::db::dblayer::Error());
}
return;
}
# Get aligned time on a Precision
sub _getAlignedTime
{
my ($time,$precision) = @_;
return $time - ($time % $precision);
}
# Internal function to get stats by SID
sub _getStatsBySID
{
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;
}
# Grab last 60 mins of data
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;
}
while (my $item = $res->fetchrow_hashref()) {
$statistics->{$item->{'timestamp'}}->{$item->{'direction'}} = {
'rate' => $item->{'rate'},
'pps' => $item->{'pps'},
'cir' => $item->{'cir'},
'limit' => $item->{'limit'},
}
}
DBFreeRes($res);
return $statistics;
}
# Internal function to get basic stats by SID
sub _getStatsBasicBySID
{
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 $res = DBSelect(SQL_GET_STATS_BASIC,$sid,$statsKey,$startTimestamp,$endTimestamp);
while (my $item = $res->fetchrow_hashref()) {
$statistics->{$item->{'timestamp'}} = {
'counter' => $item->{'counter'},
}
}
DBFreeRes($res);
return $statistics;
}
sub handle_SIGHUP
# Function to transform stats before sending them
sub _fixStatDirection
{
my ($stat,$conversions) = @_;
my $res;
# 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
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};
}
}
return $res;
}
# Function to transform stats before sending them
sub _fixCounterName
{
$logger->log(LOG_WARN,"[STATISTICS] Got SIGHUP, ignoring for now");
my ($stat,$conversions) = @_;
# Loop and set the identifier
my $newStat;
# If we have conversions defined...
my $newKey = 'counter';
if (defined($conversions) && defined($conversions->{'Name'})) {
$newKey = sprintf('%s',$conversions->{'Name'});
}
$newStat->{$newKey} = $stat->{'counter'};
return $newStat;
}
1;
# vim: ts=4
opentrafficshaper/plugins/tc/tc.pm
View file @ efc9ebe1
# OpenTrafficShaper Linux tc traffic shaping
# 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
......@@ -21,16 +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(
getLimit getLimitAttribute setLimitAttribute
getShaperState setShaperState
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
);
......@@ -41,23 +77,22 @@ our (@ISA,@EXPORT,@EXPORT_OK);
@EXPORT = qw(
);
@EXPORT_OK = qw(
getInterfaces
getConfigTxIface
getConfigRxIface
);
use constant {
VERSION => '0.0.1',
VERSION => '1.0.1',
# 5% of a link can be used for very high priority traffic
PROTO_RATE_LIMIT => 5,
PROTO_RATE_BURST_MIN => 16, # With a minimum burst of 8KiB
PROTO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max
PROTO_RATE_BURST_MIN => 16, # With a minimum burst of 8KiB
PROTO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max
# High priority traffic gets the first 20% of the bandidth to itself
PRIO_RATE_LIMIT => 20,
PRIO_RATE_BURST_MIN => 32, # With a minimum burst of 40KiB
PRIO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max
PRIO_RATE_BURST_MIN => 32, # With a minimum burst of 40KiB
PRIO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max
TC_ROOT_CLASS => 1,
};
......@@ -71,71 +106,54 @@ our $pluginInfo = {
};
# Copy of system globals
# Our globals
my $globals;
# Copy of system logger
my $logger;
# Our configuration
my $config = {
'txiface' => "eth1",
'txiface_rate' => 100,
'rxiface' => "eth0",
'rxiface_rate' => 100,
'ip_protocol' => "ip",
'iphdr_offset' => 0,
};
# Queue of tasks to run
my @taskQueue = ();
# TC classes & filters
my $tcFilterMappings;
my $tcClasses = {
'free' => [ ],
'track' => { },
};
my $tcFilters = {
'free' => [ ],
'track' => { },
};
#
# 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".VERSION." - Copyright (c) 2013, AllWorldIT");
$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'} = { };
# Check our interfaces
if (defined(my $txi = $globals->{'file.config'}->{'plugin.tc'}->{'txiface'})) {
$logger->log(LOG_INFO,"[TC] Set txiface to '$txi'");
$config->{'txiface'} = $txi;
}
if (defined(my $txir = $globals->{'file.config'}->{'plugin.tc'}->{'txiface_rate'})) {
$logger->log(LOG_INFO,"[TC] Set txiface_rate to '$txir'");
$config->{'txiface_rate'} = $txir;
}
if (defined(my $rxi = $globals->{'file.config'}->{'plugin.tc'}->{'rxiface'})) {
$logger->log(LOG_INFO,"[TC] Set rxiface to '$rxi'");
$config->{'rxiface'} = $rxi;
}
if (defined(my $rxir = $globals->{'file.config'}->{'plugin.tc'}->{'rxiface_rate'})) {
$logger->log(LOG_INFO,"[TC] Set rxiface_rate to '$rxir'");
$config->{'rxiface_rate'} = $rxir;
}
if (defined(my $proto = $globals->{'file.config'}->{'plugin.tc'}->{'protocol'})) {
$logger->log(LOG_INFO,"[TC] Set protocol to '$proto'");
# Grab some of our config we need
if (defined(my $proto = $system->{'file.config'}->{'plugin.tc'}->{'protocol'})) {
$logger->log(LOG_INFO,"[TC] Set protocol to '%s'",$proto);
$config->{'ip_protocol'} = $proto;
}
if (defined(my $offset = $globals->{'file.config'}->{'plugin.tc'}->{'iphdr_offset'})) {
$logger->log(LOG_INFO,"[TC] Set IP header offset to '$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;
}
......@@ -143,51 +161,300 @@ 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();
# Initialize TX interface
$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '$config->{'txiface'}'");
_tc_iface_init($changeSet,$config->{'txiface'},$config->{'txiface_rate'});
_tc_class_optimize($changeSet,$config->{'txiface'},3,$config->{'txiface_rate'}*1024); # Rate is in mbit
_tc_iface_optimize($changeSet,$config->{'txiface'},3,3,$config->{'txiface_rate'});
# Loop with protocols
for my $ipv ("", "6") {
# Initialize RX interface
$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '$config->{'rxiface'}'");
_tc_iface_init($changeSet,$config->{'rxiface'},$config->{'rxiface_rate'});
_tc_class_optimize($changeSet,$config->{'rxiface'},3,$config->{'rxiface_rate'}*1024); # Rate is in mbit
_tc_iface_optimize($changeSet,$config->{'rxiface'},3,3,$config->{'rxiface_rate'});
#
# 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 $interfaceID (getInterfaces()) {
my $interface = getInterface($interfaceID);
# Initialize interface
$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '%s'",$interface->{'Device'});
_tc_iface_init($changeSet,$interfaceID);
}
_task_add_to_queue($changeSet);
# This session is our main session, its alias is "shaper"
POE::Session->create(
inline_states => {
_start => \&session_start,
_stop => \&session_stop,
_start => \&_session_start,
_stop => \&_session_stop,
add => \&do_add,
change => \&do_change,
remove => \&do_remove,
class_change => \&_session_class_change,
pool_add => \&_session_pool_add,
pool_remove => \&_session_pool_remove,
pool_change => \&_session_pool_change,
poolmember_add => \&_session_poolmember_add,
poolmember_remove => \&_session_poolmember_remove,
}
);
# This is our session for communicating directly with tc, its alias is _tc
POE::Session->create(
inline_states => {
_start => \&task_session_start,
_start => \&_task_session_start,
_stop => sub { },
# Signals
_SIGCHLD => \&_task_SIGCHLD,
_SIGINT => \&_task_SIGINT,
# Public'ish
queue => \&task_add,
queue => \&_task_queue,
# Internal
task_child_stdout => \&task_child_stdout,
task_child_stderr => \&task_child_stderr,
task_child_stdin => \&task_child_stdin,
task_child_error => \&task_child_error,
task_child_close => \&task_child_close,
task_run_next => \&task_run_next,
# Signals
handle_SIGCHLD => \&task_handle_SIGCHLD,
handle_SIGINT => \&task_handle_SIGINT,
_task_child_stdout => \&_task_child_stdout,
_task_child_stderr => \&_task_child_stderr,
_task_child_stdin => \&_task_child_stdin,
_task_child_close => \&_task_child_close,
_task_child_error => \&_task_child_error,
_task_run_next => \&_task_run_next,
}
);
......@@ -195,6 +462,7 @@ sub plugin_init
}
# Start the plugin
sub plugin_start
{
......@@ -202,8 +470,9 @@ sub plugin_start
}
# Initialize this plugins main POE session
sub session_start
sub _session_start
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
......@@ -215,8 +484,9 @@ sub session_start
}
# Initialize this plugins main POE session
sub session_stop
sub _session_stop
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
......@@ -226,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");
......@@ -236,1027 +503,1110 @@ sub session_stop
}
# Add event for tc
sub do_add
# Event handler for changing a class
sub _session_class_change
{
my ($kernel,$heap,$lid) = @_[KERNEL, HEAP, ARG0];
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);
}
# Pull in limit
my $limit;
if (!defined($limit = getLimit($lid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing limit '$lid'");
# Event handler for adding a pool
sub _session_pool_add
{
my ($kernel,$heap,$pid) = @_[KERNEL, HEAP, ARG0];
# Grab pool
my $pool;
if (!defined($pool = getPool($pid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing pool '%s'",$pid);
return;
}
$logger->log(LOG_INFO,"[TC] Add '$limit->{'Username'}' [$lid]");
$logger->log(LOG_INFO,"[TC] Add pool '%s' [%s] to interface group '%s'",
$pool->{'Name'},
$pool->{'ID'},
$pool->{'InterfaceGroupID'},
);
# Grab our effective pool
my $effectivePool = getEffectivePool($pool->{'ID'});
my @components = split(/\./,$limit->{'IP'});
my $changeSet = TC::ChangeSet->new();
# Filter level 2-4
my $ip1 = $components[0];
my $ip2 = $components[1];
my $ip3 = $components[2];
my $ip4 = $components[3];
# Grab some things we need from the main pool
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Grab effective config
my $trafficClassID = $effectivePool->{'TrafficClassID'};
my $txCIR = $effectivePool->{'TxCIR'};
my $txLimit = $effectivePool->{'TxLimit'};
my $rxCIR = $effectivePool->{'RxCIR'};
my $rxLimit = $effectivePool->{'RxLimit'};
my $trafficPriority = getTrafficClassPriority($effectivePool->{'TrafficClassID'});
# Get the Tx traffic classes TC class
my $tcClass_TxTrafficClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
# Generate our pools Tx TC class
my $tcClass_TxPool = _reserveMinorTcClassByPoolID($txInterfaceID,$pool->{'ID'});
# Add the main Tx TC class for this pool
_tc_class_add($changeSet,$txInterfaceID,TC_ROOT_CLASS,$tcClass_TxTrafficClass,$tcClass_TxPool,$txCIR,
$txLimit,$trafficPriority
);
# Add Tx TC optimizations
_tc_class_optimize($changeSet,$txInterfaceID,$tcClass_TxPool,$txCIR);
# Set Tx TC class
setPoolAttribute($pool->{'ID'},'tc.txclass',$tcClass_TxPool);
# Get the Rx traffic classes TC class
my $tcClass_RxTrafficClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
# Generate our pools Rx TC class
my $tcClass_RxPool = _reserveMinorTcClassByPoolID($rxInterfaceID,$pool->{'ID'});
# Add the main Rx TC class for this pool
_tc_class_add($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$tcClass_RxTrafficClass,$tcClass_RxPool,$rxCIR,
$rxLimit,$trafficPriority
);
# Add Rx TC optimizations
_tc_class_optimize($changeSet,$rxInterfaceID,$tcClass_RxPool,$rxCIR);
# Set Rx TC
setPoolAttribute($pool->{'ID'},'tc.rxclass',$tcClass_RxPool);
# 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->{$ip1})) {
# Setup IP1's hash table
my $filterID = getTcFilter($lid);
$tcFilterMappings->{$ip1}->{'id'} = $filterID;
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
# Set current live values
setPoolAttribute($pool->{'ID'},'shaper.live.ClassID',$trafficClassID);
setPoolAttribute($pool->{'ID'},'shaper.live.TxCIR',$txCIR);
setPoolAttribute($pool->{'ID'},'shaper.live.TxLimit',$txLimit);
setPoolAttribute($pool->{'ID'},'shaper.live.RxCIR',$rxCIR);
setPoolAttribute($pool->{'ID'},'shaper.live.RxLimit',$rxLimit);
$logger->log(LOG_DEBUG,"[TC] Linking 2nd level hash table to '$filterID' to $ip1.0.0/8");
# Mark as live
unsetPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
setPoolShaperState($pool->{'ID'},SHAPER_LIVE);
}
# Create second level hash table for $ip1
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
# Link hash table
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# Root hash table
'ht','800::',
'match','ip','dst',"$ip1.0.0.0/8",
'at',16+$config->{'iphdr_offset'},
'hashkey','mask','0x00ff0000',
'at',16+$config->{'iphdr_offset'},
# Link to our hash table
'link',"$filterID:"
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# Root hash table
'ht','800::',
'match','ip','src',"$ip1.0.0.0/8",
'at',12+$config->{'iphdr_offset'},
'hashkey','mask','0x00ff0000',
'at',12+$config->{'iphdr_offset'},
# Link to our hash table
'link',"$filterID:"
]);
# Event handler for removing a pool
sub _session_pool_remove
{
my ($kernel, $pid) = @_[KERNEL, ARG0];
my $changeSet = TC::ChangeSet->new();
# Pull in pool
my $pool;
if (!defined($pool = getPool($pid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'remove' event with non existing pool '%s'",$pid);
return;
}
# Check if we have our /16 hash entry, if not we must create the 3rd level hash table
if (!defined($tcFilterMappings->{$ip1}->{$ip2})) {
my $filterID = getTcFilter($lid);
# Set 2nd level hash table ID
$tcFilterMappings->{$ip1}->{$ip2}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip1HtHex = $tcFilterMappings->{$ip1}->{'id'};
my $ip2Hex = toHex($ip2);
# Make sure its not NOTLIVE
if (getPoolShaperState($pid) & SHAPER_NOTLIVE) {
$logger->log(LOG_WARN,"[TC] Ignoring remove for pool '%s' [%s]",
$pool->{'Name'},
$pool->{'ID'}
);
return;
}
$logger->log(LOG_INFO,"[TC] Removing pool '%s' [%s]",
$pool->{'Name'},
$pool->{'ID'}
);
$logger->log(LOG_DEBUG,"[TC] Linking 3rd level hash table to '$filterID' to $ip1.$ip2.0.0/16");
# Create second level hash table for $fl1
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
# Link hash table
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# This is the 2nd level hash table
'ht',"${ip1HtHex}:${ip2Hex}:",
'match','ip','dst',"$ip1.$ip2.0.0/16",
'at',16+$config->{'iphdr_offset'},
'hashkey','mask','0x0000ff00',
'at',16+$config->{'iphdr_offset'},
# That we're linking to our hash table
'link',"$filterID:"
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# This is the 2nd level hash table
'ht',"${ip1HtHex}:${ip2Hex}:",
'match','ip','src',"$ip1.$ip2.0.0/16",
'at',12+$config->{'iphdr_offset'},
'hashkey','mask','0x0000ff00',
'at',12+$config->{'iphdr_offset'},
# That we're linking to our hash table
'link',"$filterID:"
]);
# Grab our interfaces
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Grab the traffic class from the pool
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
# Grab current class ID
my $trafficClassID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
# Grab our minor classes
my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
my $txInterface = getInterface($txInterfaceID);
my $rxInterface = getInterface($rxInterfaceID);
# Clear up the class
$changeSet->add([
'/sbin/tc','class','del',
'dev',$txInterface->{'Device'},
'parent',"1:$txTrafficClassTcClass",
'classid',"1:$txPoolTcClass",
]);
$changeSet->add([
'/sbin/tc','class','del',
'dev',$rxInterface->{'Device'},
'parent',"1:$rxTrafficClassTcClass",
'classid',"1:$rxPoolTcClass",
]);
# And recycle the classs
_disposePoolTcClass($txInterface->{'Device'},$txPoolTcClass);
_disposePoolTcClass($rxInterface->{'Device'},$rxPoolTcClass);
_disposePrioTcClass($txInterface->{'Device'},$txPoolTcClass);
_disposePrioTcClass($rxInterface->{'Device'},$rxPoolTcClass);
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
# Cleanup attributes
removePoolAttribute($pool->{'ID'},'tc.txclass');
removePoolAttribute($pool->{'ID'},'tc.rxclass');
removePoolAttribute($pool->{'ID'},'shaper.live.ClassID');
removePoolAttribute($pool->{'ID'},'shaper.live.TxCIR');
removePoolAttribute($pool->{'ID'},'shaper.live.TxLimit');
removePoolAttribute($pool->{'ID'},'shaper.live.RxCIR');
removePoolAttribute($pool->{'ID'},'shaper.live.RxLimit');
# Mark as not live
unsetPoolShaperState($pool->{'ID'},SHAPER_LIVE|SHAPER_PENDING);
setPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE);
}
## Event handler for changing a pool
sub _session_pool_change
{
my ($kernel, $pid) = @_[KERNEL, ARG0];
# Grab pool
my $pool = getPool($pid);
$logger->log(LOG_INFO,"[TC] Processing changes for '%s' [%s]",$pool->{'Name'},$pool->{'ID'});
# Grab our effective pool
my $effectivePool = getEffectivePool($pool->{'ID'});
# Grab our interfaces
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Grab the traffic class from the pool
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
# Grab effective config
my $trafficClassID = $effectivePool->{'TrafficClassID'};
my $txCIR = $effectivePool->{'TxCIR'};
my $txLimit = $effectivePool->{'TxLimit'};
my $rxCIR = $effectivePool->{'RxCIR'};
my $rxLimit = $effectivePool->{'RxLimit'};
my $trafficPriority = getTrafficClassPriority($trafficClassID);
# Grab our minor classes
my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
# Generate changeset
my $changeSet = TC::ChangeSet->new();
_tc_class_change($changeSet,$txInterfaceID,TC_ROOT_CLASS,$txTrafficClassTcClass,$txPoolTcClass,$txCIR,
$txLimit,$trafficPriority);
_tc_class_change($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$rxTrafficClassTcClass,$rxPoolTcClass,$rxCIR,
$rxLimit,$trafficPriority);
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
setPoolAttribute($pool->{'ID'},'shaper.live.ClassID',$trafficClassID);
setPoolAttribute($pool->{'ID'},'shaper.live.TxCIR',$txCIR);
setPoolAttribute($pool->{'ID'},'shaper.live.TxLimit',$txLimit);
setPoolAttribute($pool->{'ID'},'shaper.live.RxCIR',$rxCIR);
setPoolAttribute($pool->{'ID'},'shaper.live.RxLimit',$rxLimit);
# Mark as live
unsetPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
setPoolShaperState($pool->{'ID'},SHAPER_LIVE);
}
# Event handler for adding a pool member
sub _session_poolmember_add
{
my ($kernel,$heap,$pmid) = @_[KERNEL, HEAP, ARG0];
# Grab pool
my $poolMember;
if (!defined($poolMember = getPoolMember($pmid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing pool member '%s'",$pmid);
return;
}
# Check if we have our /24 hash entry, if not we must create the 4th level hash table
if (!defined($tcFilterMappings->{$ip1}->{$ip2}->{$ip3})) {
my $filterID = getTcFilter($lid);
# Set 3rd level hash table ID
$tcFilterMappings->{$ip1}->{$ip2}->{$ip3}->{'id'} = $filterID;
# Grab some hash table ID's we need
my $ip2HtHex = $tcFilterMappings->{$ip1}->{$ip2}->{'id'};
my $ip3Hex = toHex($ip3);
# Grab the pool members associated pool
my $pool;
if (!defined($pool = getPool($poolMember->{'PoolID'}))) {
$logger->log(LOG_ERR,"[TC] Shaper 'poolmember_add' event with invalid PoolID");
return;
}
$logger->log(LOG_INFO,"[TC] Add pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) to pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'ID'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
$logger->log(LOG_DEBUG,"[TC] Linking 4th level hash table to '$filterID' to $ip1.$ip2.$ip3.0/24");
# Create second level hash table for $fl1
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'handle',"$filterID:",
'protocol',$config->{'ip_protocol'},
'u32',
'divisor','256',
]);
# Link hash table
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# This is the 3rd level hash table
'ht',"${ip2HtHex}:${ip3Hex}:",
'match','ip','dst',"$ip1.$ip2.$ip3.0/24",
'at',16+$config->{'iphdr_offset'},
'hashkey','mask','0x000000ff',
'at',16+$config->{'iphdr_offset'},
# That we're linking to our hash table
'link',"$filterID:"
]);
my $changeSet = TC::ChangeSet->new();
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
# Check what IP version we're dealing with
my $ipv = "";
if ($poolMember->{'IPAddress'} =~ /:/) {
$ipv = "6";
}
# 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/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'protocol',$config->{'ip_protocol'},
'u32',
# This is the 3rd level hash table
'ht',"${ip2HtHex}:${ip3Hex}:",
'match','ip','src',"$ip1.$ip2.$ip3.0/24",
'at',12+$config->{'iphdr_offset'},
'hashkey','mask','0x000000ff',
'at',12+$config->{'iphdr_offset'},
# That we're linking to our hash table
'link',"$filterID:"
"/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);
# Mark pool member as live
unsetPoolMemberShaperState($poolMember->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_LIVE);
}
# Event handler for removing a pool member
sub _session_poolmember_remove
{
my ($kernel, $pmid) = @_[KERNEL, ARG0];
# Pull in pool member
my $poolMember;
if (!defined($poolMember = getPoolMember($pmid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'remove' event with non existing pool member '%s'",$pmid);
return;
}
# Only if we have limits setup process them
if (defined($limit->{'TrafficLimitTx'}) && defined($limit->{'TrafficLimitRx'})) {
# Build limit tc class ID
my $classID = getTcClass($lid);
# Grab some hash table ID's we need
my $ip3HtHex = $tcFilterMappings->{$ip1}->{$ip2}->{$ip3}->{'id'};
my $ip4Hex = toHex($ip4);
# Generate our filter handle
my $filterHandle = "${ip3HtHex}:${ip4Hex}:1";
# Grab the pool members associated pool
my $pool = getPool($poolMember->{'PoolID'});
# Make sure its not NOTLIVE
if (getPoolMemberShaperState($pmid) & SHAPER_NOTLIVE) {
$logger->log(LOG_WARN,"[TC] Ignoring remove for pool member '%s' with IP '%s', NAT '%s' (inbound: %s) [%s] from pool '%s'",
$poolMember->{'Username'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$poolMember->{'ID'},
$pool->{'Name'}
);
return;
}
# Save limit tc class ID
setLimitAttribute($lid,'tc.class',$classID);
setLimitAttribute($lid,'tc.filter',"${ip3HtHex}:${ip4Hex}:1");
$logger->log(LOG_INFO,"[TC] Remove pool member '%s' [%s] with IP '%s', NAT '%s' (inbound: %s) from pool '%s' [%s]",
$poolMember->{'Username'},
$poolMember->{'ID'},
$poolMember->{'IPAddress'},
$poolMember->{'IPNATAddress'} // "",
$poolMember->{'IPNATInbound'} // "",
$pool->{'Name'},
$pool->{'ID'}
);
#
# SETUP MAIN TRAFFIC LIMITS
#
# Create main rate limiting classes
$changeSet->add([
'/sbin/tc','class','add',
'dev',$config->{'txiface'},
'parent','1:2',
'classid',"1:$classID",
'htb',
'rate', $limit->{'TrafficLimitTx'} . "kbit",
'ceil', $limit->{'TrafficLimitTxBurst'} . "kbit",
'prio', $limit->{'TrafficPriority'},
]);
$changeSet->add([
'/sbin/tc','class','add',
'dev',$config->{'rxiface'},
'parent','1:2',
'classid',"1:$classID",
'htb',
'rate', $limit->{'TrafficLimitRx'} . "kbit",
'ceil', $limit->{'TrafficLimitRxBurst'} . "kbit",
'prio', $limit->{'TrafficPriority'},
]);
my $changeSet = TC::ChangeSet->new();
#
# SETUP DEFAULT CLASSIFICATION OF TRAFFIC
#
my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
# Default traffic classification to main class
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'handle',$filterHandle,
'protocol',$config->{'ip_protocol'},
'u32',
'ht',"${ip3HtHex}:${ip4Hex}:",
'match','ip','dst',$limit->{'IP'},
'at',16+$config->{'iphdr_offset'},
'flowid',"1:$classID",
]);
my $txInterface = getInterface($txInterfaceID);
my $rxInterface = getInterface($rxInterfaceID);
my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
# Check what IP version we're dealing with
my $ipv = "";
if ( $poolMember->{'IPAddress'} =~ /:/ ) {
$ipv = 6;
}
# Remove traffic classification
$changeSet->add([
"/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/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/tc','filter','add',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'handle',$filterHandle,
'protocol',$config->{'ip_protocol'},
'u32',
'ht',"${ip3HtHex}:${ip4Hex}:",
'match','ip','src',$limit->{'IP'},
'at',12+$config->{'iphdr_offset'},
'flowid',"1:$classID",
"/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'},
]);
_tc_class_optimize($changeSet,$config->{'txiface'},$classID,$limit->{'TrafficLimitTx'});
_tc_class_optimize($changeSet,$config->{'rxiface'},$classID,$limit->{'TrafficLimitRx'});
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);
# Mark as live
setShaperState($lid,SHAPER_LIVE);
# Mark as not live
unsetPoolMemberShaperState($poolMember->{'ID'},SHAPER_LIVE|SHAPER_PENDING);
setPoolMemberShaperState($poolMember->{'ID'},SHAPER_NOTLIVE);
}
# Change event for tc
sub do_change
# Grab pool ID from TC class
sub getPIDFromTcClass
{
my ($kernel, $lid, $changes) = @_[KERNEL, ARG0];
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
my $changeSet = TC::ChangeSet->new();
# Return the pool ID if found
my $ref = __getRefByMinorTcClass($interfaceID,$majorTcClass,$minorTcClass);
if (!defined($ref) || substr($ref,0,13) ne "_pool_class_:") {
return;
}
return substr($ref,13);
}
# Pull in limit
my $limit;
if (!defined($limit = getLimit($lid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'change' event with non existing limit '$lid'");
# Function to return if this is linked to a pool's class
sub isPoolTcClass
{
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
my $pid = getPIDFromTcClass($interfaceID,$majorTcClass,$minorTcClass);
if (!defined($pid)) {
return;
}
$logger->log(LOG_INFO,"Processing changes for '$limit->{'Username'}' [$lid]");
return $minorTcClass;
}
# Return the ClassID from a TC class
# This is similar to isTcTrafficClassValid() but returns the ref, not the minor class
sub getCIDFromTcClass
{
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
# Grab ref
my $ref = __getRefByMinorTcClass($interfaceID,$majorTcClass,$minorTcClass);
# We going to pull in the defaults
my $trafficLimitTx = $limit->{'TrafficLimitTx'};
my $trafficLimitRx = $limit->{'TrafficLimitRx'};
my $trafficLimitTxBurst = $limit->{'TrafficLimitTxBurst'};
my $trafficLimitRxBurst = $limit->{'TrafficLimitRxBurst'};
# Lets see if we can override them...
if (defined($changes->{'TrafficLimitTx'})) {
$trafficLimitTx = $changes->{'TrafficLimitTx'};
# If we're undefined return
if (!defined($ref)) {
return;
}
if (defined($changes->{'TrafficLimitRx'})) {
$trafficLimitRx = $changes->{'TrafficLimitRx'};
# If we're not a traffic class, just return
if (substr($ref,0,16) ne "_traffic_class_:") {
return;
}
if (defined($changes->{'TrafficLimitTxBurst'})) {
$trafficLimitTxBurst = $changes->{'TrafficLimitTxBurst'};
# Else return the part after the above tag
return substr($ref,16);
}
#
# Internal functions
#
# Function to initialize an interface
sub _tc_iface_init
{
my ($changeSet,$interfaceID) = @_;
# Grab our interface rate
my $interface = getInterface($interfaceID);
### --- Interface Setup
# Clear the qdisc from the interface
$changeSet->add([
'/sbin/tc','qdisc','del',
'dev',$interface->{'Device'},
'root',
]);
# Initialize the major TC class
my $interfaceTcClass = _reserveMajorTcClass($interfaceID,"root");
# Set interface RootClass
$globals->{'Interfaces'}->{$interfaceID} = {
'TcClass' => $interfaceTcClass
};
### --- Interface Traffic Class Setup
# Reserve our parent TC classes
my @trafficClasses = getAllTrafficClasses();
foreach my $trafficClassID (sort {$a <=> $b} @trafficClasses) {
# Record the class we get for this interface traffic class ID
my $interfaceTrafficClassTcClass = _reserveMinorTcClassByTrafficClassID($interfaceID,$trafficClassID);
}
if (defined($changes->{'TrafficLimitRxBurst'})) {
$trafficLimitRxBurst = $changes->{'TrafficLimitRxBurst'};
### --- Interface Setup Part 2
# Add root qdisc
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$interface->{'Device'},
'root',
'handle','1:',
'htb'
]);
# 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->{'Device'},
'parent','1:',
'classid','1:1',
'htb',
'rate',"$interface->{'Limit'}kbit",
]);
# 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'}
};
### --- 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->{'Device'},
'parent','1:1',
'classid',"1:$tcClass",
'htb',
'rate',"$interfaceTrafficClass->{'CIR'}kbit",
'ceil',"$interfaceTrafficClass->{'Limit'}kbit",
'prio',$trafficPriority,
]);
# 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)) {
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",
]);
}
# 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,$interfaceID,$poolTcClass,$rate) = @_;
my $interface = getInterface($interfaceID);
my $prioTcClass = _reserveMajorTcClassByPrioClass($interfaceID,$poolTcClass);
# 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->{'Device'},
'parent',"1:$poolTcClass",
'handle',"$prioTcClass:",
'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,
]);
}
# Function to add a TC class
sub _tc_class_add
{
my ($changeSet,$interfaceID,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
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
# Create main rate limiting classes
$changeSet->add([
'/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 change a TC class
sub _tc_class_change
{
my ($changeSet,$interfaceID,$majorTcClass,$trafficClassTcClass,$poolTcClass,$rate,$ceil,$trafficPriority) = @_;
my $classID = getLimitAttribute($lid,'tc.class');
my $interface = getInterface($interfaceID);
my @args = ();
# If ceil is not available, set it to the CIR (or $rate in this case)
if (!defined($ceil)) {
$ceil = $rate;
}
# # 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','class','change',
'dev',$config->{'txiface'},
'parent','1:2',
'classid',"1:$classID",
'htb',
'rate', $trafficLimitTx . "kbit",
'ceil', $trafficLimitTxBurst . "kbit",
'prio', $limit->{'TrafficPriority'},
]);
$changeSet->add([
'/sbin/tc','class','change',
'dev',$config->{'rxiface'},
'parent','1:2',
'classid',"1:$classID",
'dev',$interface->{'Device'},
'parent',"$majorTcClass:$trafficClassTcClass",
'classid',"$majorTcClass:$poolTcClass",
'htb',
'rate', $trafficLimitRx . "kbit",
'ceil', $trafficLimitRxBurst . "kbit",
'prio', $limit->{'TrafficPriority'},
'rate', "${rate}kbit",
'ceil', "${ceil}kbit",
# 'burst', "${burst}kb",
# 'cburst', "${cburst}kb",
@args
]);
}
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
# Get a pool TC class from pool ID
sub _reserveMinorTcClassByPoolID
{
my ($interfaceID,$pid) = @_;
return __reserveMinorTcClass($interfaceID,TC_ROOT_CLASS,"_pool_class_:$pid");
}
# Remove event for tc
sub do_remove
# Get a traffic class TC class
sub _reserveMinorTcClassByTrafficClassID
{
my ($kernel, $lid) = @_[KERNEL, ARG0];
my ($interfaceID,$trafficClassID) = @_;
my $changeSet = TC::ChangeSet->new();
return __reserveMinorTcClass($interfaceID,TC_ROOT_CLASS,"_traffic_class_:$trafficClassID");
}
# Pull in limit
my $limit;
if (!defined($limit = getLimit($lid))) {
$logger->log(LOG_ERR,"[TC] Shaper 'change' event with non existing limit '$lid'");
return;
}
$logger->log(LOG_INFO,"[TC] Remove '$limit->{'Username'}' [$lid]");
# Get a prio class TC class
# This is a MAJOR class!
sub _reserveMajorTcClassByPrioClass
{
my ($interfaceID,$trafficClassID) = @_;
# Grab ClassID
my $classID = getLimitAttribute($lid,'tc.class');
my $filterHandle = getLimitAttribute($lid,'tc.filter');
# Clear up the filter
$changeSet->add([
'/sbin/tc','filter','del',
'dev',$config->{'txiface'},
'parent','1:',
'prio','10',
'handle',$filterHandle,
'protocol',$config->{'ip_protocol'},
'u32',
]);
$changeSet->add([
'/sbin/tc','filter','del',
'dev',$config->{'rxiface'},
'parent','1:',
'prio','10',
'handle',$filterHandle,
'protocol',$config->{'ip_protocol'},
'u32',
]);
# Clear up the class
$changeSet->add([
'/sbin/tc','class','del',
'dev',$config->{'txiface'},
'parent','1:2',
'classid',"1:$classID",
]);
$changeSet->add([
'/sbin/tc','class','del',
'dev',$config->{'rxiface'},
'parent','1:2',
'classid',"1:$classID",
]);
return _reserveMajorTcClass($interfaceID,"_priority_class_:$trafficClassID");
}
# And recycle the class
disposeTcClass($classID);
# Post changeset
$kernel->post("_tc" => "queue" => $changeSet);
# Mark as not live
setShaperState($lid,SHAPER_NOTLIVE);
# Return TC class from a traffic class ID
sub _getTcClassFromTrafficClassID
{
my ($interfaceID,$trafficClassID) = @_;
return __getMinorTcClassByRef($interfaceID,TC_ROOT_CLASS,"_traffic_class_:$trafficClassID");
}
# Function to get next available TC filter
sub getTcFilter
# Return prio TC class using class
# This returns a MAJOR class from a tc class
sub _getPrioTcClass
{
my $lid = shift;
my ($interfaceID,$tcClass) = @_;
return __getMajorTcClassByRef($interfaceID,"_priority_class_:$tcClass");
}
my $id = pop(@{$tcFilters->{'free'}});
# Generate new number
if (!$id) {
$id = keys %{$tcFilters->{'track'}};
# Bump ID up by 10
$id += 100;
# We cannot use ID 800, its internal
$id = 801 if ($id == 800);
# Hex it
$id = toHex($id);
}
$tcFilters->{'track'}->{$id} = $lid;
# Function to dispose of a TC class
sub _disposePoolTcClass
{
my ($interfaceID,$tcClass) = @_;
return $id;
return __disposeMinorTcClass($interfaceID,TC_ROOT_CLASS,$tcClass);
}
# Function to dispose of a TC Filter
sub disposeTcFilter
# Function to dispose of a major TC class
# Uses a TC class to get a MAJOR class, then disposes it
sub _disposePrioTcClass
{
my $id = shift;
my ($interfaceID,$tcClass) = @_;
# Push onto free list
push(@{$tcFilters->{'free'}},$id);
# Blank the value
$tcFilters->{'track'}->{$id} = undef;
# If we can grab the major class dipose of it
my $majorTcClass = _getPrioTcClass($interfaceID,$tcClass);
if (!defined($majorTcClass)) {
return;
}
return __disposeMajorTcClass($interfaceID,$majorTcClass);
}
# Function to get next available TC class
sub getTcClass
sub __reserveMinorTcClass
{
my $lid = shift;
my ($interfaceID,$majorTcClass,$ref) = @_;
# Setup defaults if we don't have anything defined
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass} = {
# Skip 0 and 1
'Counter' => 2,
'Free' => [ ],
'Track' => { },
'Reverse' => { },
};
}
my $id = pop(@{$tcClasses->{'free'}});
# Maybe we have one free?
my $minorTcClass = shift(@{$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Free'}});
# Generate new number
if (!$id) {
$id = keys %{$tcClasses->{'track'}};
$id += 100;
if (!$minorTcClass) {
$minorTcClass = $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Counter'}++;
# Hex it
$id = toHex($id);
$minorTcClass = toHex($minorTcClass);
}
$tcClasses->{'track'}->{$id} = $lid;
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$minorTcClass} = $ref;
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref} = $minorTcClass;
return $id;
return $minorTcClass;
}
# Function to dispose of a TC class
sub disposeTcClass
# Function to get next available major TC class
sub _reserveMajorTcClass
{
my $id = shift;
my ($interfaceID,$ref) = @_;
# Setup defaults if we don't have anything defined
if (!defined($globals->{'TcClasses'}->{$interfaceID})) {
$globals->{'TcClasses'}->{$interfaceID} = {
# Skip 0
'Counter' => 1,
'Free' => [ ],
'Track' => { },
'Reverse' => { },
};
}
# Push onto free list
push(@{$tcClasses->{'free'}},$id);
# Blank the value
$tcClasses->{'track'}->{$id} = undef;
}
# Maybe we have one free?
my $majorTcClass = shift(@{$globals->{'TcClasses'}->{$interfaceID}->{'Free'}});
# Generate new number
if (!$majorTcClass) {
$majorTcClass = $globals->{'TcClasses'}->{$interfaceID}->{'Counter'}++;
# Hex it
$majorTcClass = toHex($majorTcClass);
}
# Grab limit ID from TC class
sub getLIDFromTcClass
{
my $class = shift;
$globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$majorTcClass} = $ref;
$globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref} = $majorTcClass;
return $tcClasses->{'track'}->{$class};
return $majorTcClass;
}
# Get interfaces we manage
sub getInterfaces
# Get a minor class by its rerf
sub __getMinorTcClassByRef
{
return ($config->{'txiface'},$config->{'rxiface'});
}
my ($interfaceID,$majorTcClass,$ref) = @_;
# Get TX iface
sub getConfigTxIface
{
return $config->{'txiface'};
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
return;
}
return $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref};
}
# Get RX iface
sub getConfigRxIface
# Get a major class by its rerf
sub __getMajorTcClassByRef
{
return $config->{'rxiface'};
my ($interfaceID,$ref) = @_;
if (!defined($globals->{'TcClasses'}->{$interfaceID})) {
return;
}
return $globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref};
}
# Function to initialize an interface
sub _tc_iface_init
# Get ref using the minor tc class
sub __getRefByMinorTcClass
{
my ($changeSet,$iface,$rate) = @_;
my ($interfaceID,$majorTcClass,$minorTcClass) = @_;
# Work out rates
my $BERate = int($rate/10); # We use 10% of the rate for Best effort
my $CIRate = $rate - $BERate; # Rest is for our clients
if (!defined($globals->{'TcClasses'}->{$interfaceID}) || !defined($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass})) {
return;
}
$changeSet->add([
'/sbin/tc','qdisc','del',
'dev',$iface,
'root',
]);
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$iface,
'root',
'handle','1:',
'htb',
'default','3' # Push any unclassified traffic to 1:3
]);
$changeSet->add([
'/sbin/tc','class','add',
'dev',$iface,
'parent','1:',
'classid','1:1',
'htb',
'rate',"${rate}mbit",
]);
$changeSet->add([
'/sbin/tc','class','add',
'dev',$iface,
'parent','1:1',
'classid','1:2',
'htb',
'rate',"${CIRate}mbit",
'ceil',"${rate}mbit",
# Highest priority
'prio','5',
]);
$changeSet->add([
'/sbin/tc','class','add',
'dev',$iface,
'parent','1:1',
'classid','1:3',
'htb',
'rate',"${BERate}mbit",
'ceil',"${rate}mbit",
# Lowest priority
'prio','7',
]);
return $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$minorTcClass};
}
# Function to apply SFQ to the interface priority classes
sub _tc_iface_optimize
# Function to dispose of a TC class
sub __disposeMinorTcClass
{
my ($changeSet,$iface,$prioClass,$prioCount,$rate) = @_;
my ($interfaceID,$majorTcClass,$tcMinorClass) = @_;
# Make the queue size big enough
my $queueSize = ($rate * 1024 * 1024) / 8;
my $ref = $globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$tcMinorClass};
# Push onto free list
push(@{$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Free'}},$tcMinorClass);
# Blank the value
$globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Track'}->{$tcMinorClass} = undef;
delete($globals->{'TcClasses'}->{$interfaceID}->{$majorTcClass}->{'Reverse'}->{$ref});
}
# RED metrics (sort of as per manpage)
my $redAvPkt = 1000;
my $redMax = int($queueSize / 4);
my $redMin = int($redMax / 3);
my $redBurst = int( ($redMin+$redMin+$redMax) / (4*$redAvPkt));
my $redLimit = $queueSize;
# Use $i as an increasing number to be added to the base class
my $i = 1;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$iface,
'parent',"$prioClass:$i",
'handle',$prioClass+$i.":",
'bfifo',
'limit',$queueSize,
]);
$i++;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$iface,
'parent',"$prioClass:$i",
'handle',$prioClass+$i.":",
# FIXME: 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,
'ecn'
# XXX: Very new kernels only ... use redflowlimit in future
# 'sfq',
# 'divisor','16384',
# 'headdrop',
# 'redflowlimit',$queueSize,
# 'ecn',
]);
# Function to dispose of a major TC class
sub __disposeMajorTcClass
{
my ($interfaceID,$tcMajorClass) = @_;
$i++;
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$iface,
'parent',"$prioClass:$i",
'handle',$prioClass+$i.":",
'red',
'min',$redMin,
'max',$redMax,
'limit',$redLimit,
'burst',$redBurst,
'avpkt',$redAvPkt,
'ecn'
]);
my $ref = $globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$tcMajorClass};
# Push onto free list
push(@{$globals->{'TcClasses'}->{$interfaceID}->{'Free'}},$tcMajorClass);
# Blank the value
$globals->{'TcClasses'}->{$interfaceID}->{'Track'}->{$tcMajorClass} = undef;
delete($globals->{'TcClasses'}->{$interfaceID}->{'Reverse'}->{$ref});
}
# Function to apply traffic optimizations to a classes
sub _tc_class_optimize
# Function to get next available TC filter
sub _reserveTcFilter
{
my ($changeSet,$iface,$classID,$rate) = @_;
my ($interfaceID,$ref) = @_;
# 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;
# Setup defaults if we don't have anything defined
if (!defined($globals->{'TcFilters'}->{$interfaceID})) {
$globals->{'TcFilters'}->{$interfaceID} = {
# Skip 0 and 1
'Counter' => 2,
'Free' => [ ],
'Track' => { },
};
}
#
# DEFINE 3 PRIO BANDS
#
# Maybe we have one free?
my $filterID = shift(@{$globals->{'TcFilters'}->{$interfaceID}->{'Free'}});
# We then prioritize traffic into 3 bands based on TOS
$changeSet->add([
'/sbin/tc','qdisc','add',
'dev',$iface,
'parent',"1:$classID",
'handle',"$classID:",
'prio',
'bands','3',
'priomap','2','2','2','2','2','2','2','2','2','2','2','2','2','2','2','2',
]);
# Generate new number
if (!$filterID) {
$filterID = $globals->{'TcFilters'}->{$interfaceID}->{'Counter'}++;
# We cannot use ID 800, its internal
$filterID = $globals->{'TcFilters'}->{$interfaceID}->{'Counter'}++ if ($filterID == 800);
# Hex it
$filterID = toHex($filterID);
}
$globals->{'TcFilters'}->{$interfaceID}->{'Track'}->{$filterID} = $ref;
#
# CLASSIFICATIONS
#
return $filterID;
}
# Prioritize ICMP up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# Prioritize ACK up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# Prioritize SYN-ACK up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# Prioritize FIN up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# Prioritize RST up to a certain limit
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# DNS
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# VOIP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# SNMP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# FIXME: Make this customizable not hard coded
# Mikrotik Management Port
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:1",
]);
# SMTP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
# POP3
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
# IMAP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
# HTTP
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
# HTTPS
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
$changeSet->add([
'/sbin/tc','filter','add',
'dev',$iface,
'parent',"$classID:",
'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',"$classID:2",
]);
# Function to dispose of a TC Filter
sub _disposeTcFilter
{
my ($interfaceID,$filterID) = @_;
# Push onto free list
push(@{$globals->{'TcFilters'}->{$interfaceID}->{'Free'}},$filterID);
# Blank the value
$globals->{'TcFilters'}->{$interfaceID}->{'Track'}->{$filterID} = undef;
}
......@@ -1265,8 +1615,10 @@ sub _tc_class_optimize
# Task/child communication & handling stuff
#
# Initialize our tc session
sub task_session_start
sub _task_session_start
{
my $kernel = $_[KERNEL];
......@@ -1274,13 +1626,14 @@ sub task_session_start
$kernel->alias_set("_tc");
# Setup handing of console INT
$kernel->sig('INT', 'handle_SIGINT');
$kernel->sig("INT", "_SIGINT");
# Fire things up, we trigger this to process the task queue generated during init
$kernel->yield("task_run_next");
$kernel->yield("_task_run_next");
}
# Add task to queue
sub _task_add_to_queue
{
......@@ -1290,43 +1643,17 @@ 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++;
}
# Shove task on list
$logger->log(LOG_DEBUG,"[TC] TASK: Queued $numChanges changes");
$logger->log(LOG_DEBUG,"[TC] TASK: Queued %s changes",$numChanges);
}
# 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/".$task->ID.": Starting '$cmdStr' as ".$task->ID." with PID ".$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;
}
}
# Run a task
sub task_add
# Queue a task
sub _task_queue
{
my ($kernel,$heap,$changeSet) = @_[KERNEL,HEAP,ARG0];
......@@ -1334,160 +1661,150 @@ sub task_add
# Internal function to add command to queue
_task_add_to_queue($changeSet);
# Trigger a run if list is empty
#if (@taskQueue < 2) {
if (@taskQueue) {
$kernel->yield("task_run_next");
# Trigger a run if list is not empty
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Run next task
sub task_run_next
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', '-batch' ],
StdioFilter => POE::Filter::Line->new(),
StderrFilter => POE::Filter::Line->new(),
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");
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',
# 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, "handle_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
sub _task_child_stdout
{
my ($kernel,$heap,$stdout,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
my $task = $heap->{'task_by_wid'}->{$task_id};
$logger->log(LOG_INFO,"[TC] TASK/$task_id: STDOUT => ".$stdout);
$logger->log(LOG_INFO,"[TC] TASK/%s: STDOUT => %s",$task_id,$stdout);
}
# Child writes to STDERR
sub task_child_stderr
sub _task_child_stderr
{
my ($kernel,$heap,$stdout,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
my $task = $heap->{'task_by_wid'}->{$task_id};
$logger->log(LOG_WARN,"[TC] TASK/$task_id: STDERR => ".$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/$task_id is READY");
# And shove another queued command its direction
_task_put_next($heap,$task);
$logger->log(LOG_WARN,"[TC] TASK/%s: STDERR => %s",$task_id,$stdout);
}
# Child closed its handles, it won't communicate with us, so remove it
sub task_child_close
sub _task_child_close
{
my ($kernel,$heap,$task_id) = @_[KERNEL,HEAP,ARG0];
my $task = $heap->{'task_by_wid'}->{$task_id};
# May have been reaped by task_sigchld()
if (!defined($task)) {
$logger->log(LOG_DEBUG,"[TC] TASK/$task_id: Closed dead child");
$logger->log(LOG_DEBUG,"[TC] TASK/%s: Closed dead child",$task_id);
return;
}
$logger->log(LOG_DEBUG,"[TC] TASK/$task_id: Closed PID ".$task->PID);
$logger->log(LOG_DEBUG,"[TC] TASK/%s: Closed PID %s",$task_id,$task->PID);
# 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) {
$kernel->yield("task_run_next");
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Child got an error event, lets remove it too
sub task_child_error
sub _task_child_error
{
my ($kernel,$heap,$operation,$errnum,$errstr,$task_id) = @_[KERNEL,HEAP,ARG0..ARG3];
my $task = $heap->{'task_by_wid'}->{$task_id};
if ($operation eq "read" && !$errnum) {
$errstr = "Remote end closed"
}
$logger->log(LOG_ERR,"[TC] Task $task_id generated $operation error $errnum: '$errstr'");
$logger->log(LOG_ERR,"[TC] Task %s generated %s error %s: '%s'",$task_id,$operation,$errnum,$errstr);
# If there is no task, return
if (!defined($task)) {
return;
}
return if (!defined($task));
# 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) {
$kernel->yield("task_run_next");
if (@{$globals->{'TaskQueue'}}) {
$kernel->yield("_task_run_next");
}
}
# Reap the dead child
sub task_handle_SIGCHLD
sub _task_SIGCHLD
{
my ($kernel,$heap,$pid,$status) = @_[KERNEL,HEAP,ARG1,ARG2];
my $task = $heap->{'task_by_pid'}->{$pid};
$logger->log(LOG_DEBUG,"[TC] TASK: Task with PID $pid exited with status $status");
my $task = $heap->{'task_by_pid'}->{$pid};
$logger->log(LOG_DEBUG,"[TC] TASK: Task with PID %s exited with status %s",$pid,$status);
# May have been reaped by task_child_close()
return if (!defined($task));
......@@ -1495,15 +1812,16 @@ sub task_handle_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_handle_SIGINT
sub _task_SIGINT
{
my ($kernel,$heap,$signal_name) = @_[KERNEL,HEAP,ARG0];
# Shutdown stdin on all children, this will terminate /sbin/tc
foreach my $task_id (keys %{$heap->{'task_by_wid'}}) {
my $task = $heap->{'task_by_wid'}{$task_id};
......@@ -1517,9 +1835,6 @@ sub task_handle_SIGINT
# TC changeset item
package TC::ChangeSet;
......@@ -1540,6 +1855,7 @@ sub new
}
# Add a change to the list
sub add
{
......@@ -1549,6 +1865,7 @@ sub add
}
# Return the list
sub extract
{
......@@ -1559,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-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
# the Free Software Foundation, either version 3 of the License, or
......@@ -24,10 +24,15 @@ use warnings;
use POE qw( Wheel::Run Filter::Line );
use opentrafficshaper::POE::Filter::TCStatistics;
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::utils;
use opentrafficshaper::plugins::configmanager qw(
getInterface
getInterfaces
);
# Exporter stuff
......@@ -40,9 +45,9 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
use constant {
VERSION => '0.0.1',
VERSION => '1.0.0',
# How often our config check ticks
# How often we tick
TICK_PERIOD => 5,
};
......@@ -51,48 +56,55 @@ use constant {
our $pluginInfo = {
Name => "Linux tc Statistics Interface",
Version => VERSION,
Init => \&plugin_init,
Start => \&plugin_start,
Requires => ["tc","statistics"],
# Signals
signal_SIGHUP => \&handle_SIGHUP,
};
# Copy of system globals
# Our globals
my $globals;
# Copy of system logger
my $logger;
# Our configuration
my $config = {
};
# Last stats pulls
#
# $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".VERSION." - Copyright (c) 2013, AllWorldIT");
$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 => {
_start => \&session_init,
tick => \&session_tick,
# Internal
task_child_stdout => \&task_child_stdout,
task_child_stderr => \&task_child_stderr,
task_child_close => \&task_child_close,
_start => \&_session_start,
_stop => \&_session_stop,
_tick => \&_session_tick,
_task_child_stdout => \&_task_child_stdout,
_task_child_stderr => \&_task_child_stderr,
_task_child_close => \&_task_child_close,
_SIGCHLD => \&_task_handle_SIGCHLD,
_SIGINT => \&_task_handle_SIGINT,
}
);
......@@ -100,259 +112,285 @@ 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_init {
my $kernel = $_[KERNEL];
sub _session_start
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# Set our alias
$kernel->alias_set("tcstats");
# Set delay on config updates
$kernel->delay(tick => TICK_PERIOD);
$kernel->delay('_tick' => TICK_PERIOD);
$logger->log(LOG_DEBUG,"[TCSTATS] Initialized");
}
# Time ticker for processing changes
sub session_tick {
my ($kernel,$heap) = @_[KERNEL,HEAP];
# Suck in global
my $users = $globals->{'users'};
my $tcConfig = $opentrafficshaper::plugins::tc::config;
# Shut down session
sub _session_stop
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# Now
my $now = time();
$kernel->alias_remove("tcstats");
my $iface = "eth1";
# Blow everything away
$globals = undef;
# Work out traffic direction
my $direction;
if ($iface eq opentrafficshaper::plugins::tc::getConfigTxIface()) {
$direction = 'tx';
} elsif ($iface eq opentrafficshaper::plugins::tc::getConfigRxIface()) {
$direction = 'rx';
} else {
# Reset tick
$kernel->delay(tick => TICK_PERIOD);
$logger->log(LOG_ERR,"[TCSTATS] Unknown interface '$iface'");
return;
}
$logger->log(LOG_DEBUG,"[TCSTATS] Shutdown");
# TC commands to run
my $cmd = [ '/sbin/tc', '-s', 'class', 'show', 'dev', $iface ];
# Create task
my $task = POE::Wheel::Run->new(
Program => $cmd,
# We get full lines back
StdioFilter => POE::Filter::Line->new(),
StderrFilter => POE::Filter::Line->new(),
StdoutEvent => 'task_child_stdout',
StderrEvent => 'task_child_stderr',
CloseEvent => 'task_child_close',
) or $logger->log(LOG_ERR,"[TCSTATS] TC: Unable to start task");
# Intercept SIGCHLD
$kernel->sig_child($task->PID, "sig_child");
# 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->PID} = $task;
# Signal events include the process ID.
$heap->{task_data}->{$task->ID} = {
'timestamp' => $now,
'iface' => $iface,
'direction' => $direction,
'stats' => { }
};
# Build commandline string
my $cmdStr = join(' ',@{$cmd});
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/".$task->ID.": Starting '$cmdStr' as ".$task->ID." with PID ".$task->PID);
};
$logger = undef;
}
# Child writes to STDOUT
sub task_child_stdout
{
my ($kernel,$heap,$stdout,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
my $child = $heap->{task_by_wid}->{$task_id};
my $stats = $heap->{task_data}->{$task_id}->{'stats'};
my $iface = $heap->{task_data}->{$task_id}->{'iface'};
my $direction = $heap->{task_data}->{$task_id}->{'direction'};
my $timestamp = $heap->{task_data}->{$task_id}->{'timestamp'};
# Time ticker for processing changes
sub _session_tick
{
my ($kernel,$heap) = @_[KERNEL,HEAP];
# $logger->log(LOG_INFO,"[TCSTATS] TASK/$task_id: STDOUT => ".$stdout);
# Now
my $now = time();
# If we have a class, blank our stats
if ($stdout =~ /^class /) {
%{$stats} = ( );
# Get sorted list of interfaces
my @interfaces = sort { $globals->{'LastStats'}->{$a} <=> $globals->{'LastStats'}->{$b} } getInterfaces();
# 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'",$interfaceID);
# TC commands to run
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 => opentrafficshaper::POE::Filter::TCStatistics->new(),
StderrFilter => POE::Filter::Line->new(),
StdoutEvent => '_task_child_stdout',
StderrEvent => '_task_child_stderr',
CloseEvent => '_task_child_close',
) or $logger->log(LOG_ERR,"[TCSTATS] TC: Unable to start task");
# Intercept SIGCHLD
$kernel->sig_child($task->ID, "_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->PID} = $task;
# Signal events include the process ID.
$heap->{task_data}->{$task->ID} = {
'Timestamp' => $now,
'Interface' => $interfaceID,
'CurrentStat' => { }
};
# Build commandline string
my $cmdStr = join(' ',@{$cmd});
$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
$globals->{'LastStats'}->{$interfaceID} = $now;
# Grab next one for below calcs...
$interfaceID = shift(@interfaces);
}
# class htb 1:1 root rate 100000Kbit ceil 100000Kbit burst 51800b cburst 51800b
# class htb 1:3 parent 1:1 leaf 3: prio 7 rate 10000Kbit ceil 100000Kbit burst 6620b cburst 51800b
if ($stdout =~ /^class htb ([0-9a-f]+:[0-9a-f]+) (?:parent )?([0-9a-f]+:[0-9a-f]+|root) (?:leaf ([0-9a-f]+): )?(?:prio ([0-9]+) )?rate ([0-9]+[MKG]?)bit ceil ([0-9]+[MKG]?)bit /) {
my ($chandle,$phandle,$leaf,$prio,$rate,$ceil) = ($1,$2,$3,$4,$5,$6);
($stats->{'_class_parent'},$stats->{'_class_child'}) = split(/:/,$chandle);
# ($stats->{'_chandle_main'},$stats->{'_chandle_sub'}) = split(/:/,$chandle);
# $stats->{'_phandle'} = $phandle;
# $stats->{'_leaf'} = $leaf;
$stats->{'priority'} = $prio;
$stats->{'rate'} = $rate;
$stats->{'rate_burst'} = $ceil;
# $logger->log(LOG_DEBUG,"[TCSTATS] FOUND: chandle = $chandle, phandle = $phandle, leaf = $leaf, prio = $prio, rate = $rate, ceil = $ceil");
# 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;
}
# Sent 0 bytes 0 pkt (dropped 0, overlimits 0 requeues 0)
} elsif ($stdout =~ / Sent ([0-9]+) bytes ([0-9]+) pkt \(dropped ([0-9]+), overlimits ([0-9]+) requeues ([0-9]+)\)/) {
my ($sent_bytes,$sent_packets,$dropped,$overlimits,$requeues) = ($1,$2,$3,$4,$5);
$kernel->delay('_tick' => $tickPeriod);
};
$stats->{'total_bytes'} = $sent_bytes;
$stats->{'total_packets'} = $sent_packets;
$stats->{'total_dropped'} = $dropped;
$stats->{'total_overlimits'} = $overlimits;
# $logger->log(LOG_DEBUG,"[TCSTATS] FOUND: sent_bytes = $sent_bytes, sent_packets = $sent_packets, dropped = $dropped, overlimits = $overlimits, requeues = $requeues");
# rate 0bit 0pps backlog 0b 0p requeues 0
} elsif ($stdout =~ / rate ([0-9]+[MKG]?)bit ([0-9]+)pps backlog ([0-9]+[MKG]?)b ([0-9]+)p requeues ([0-9]+)/) {
my ($rate_bits,$rate_packets,$backlog_bytes,$backlog_packets,$requeues) = ($1,$2,$3,$4,$5);
# Child writes to STDOUT
sub _task_child_stdout
{
my ($kernel,$heap,$stat,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
$stats->{'current_rate'} = $rate_bits;
$stats->{'current_pps'} = $rate_packets;
$stats->{'current_queue_size'} = $backlog_bytes;
$stats->{'current_queue_len'} = $backlog_packets;
# $logger->log(LOG_DEBUG,"[TCSTATS] FOUND: rate_bits = $rate_bits, rate_packets = $rate_packets, backlog_bytes = $backlog_bytes, backlog_packets = $backlog_packets, requeues = $requeues");
my $task = $heap->{task_by_wid}->{$task_id};
# lended: 0 borrowed: 0 giants: 0
} elsif ($stdout =~ / lended: ([0-9]+) borrowed: ([0-9]+) giants: ([0-9]+)/) {
my ($lended,$borrowed,$giants) = ($1,$2,$3);
# Grab task data
my $taskData = $heap->{'task_data'}->{$task_id};
$stats->{'lended'} = $lended;
$stats->{'borrowed'} = $borrowed;
# $logger->log(LOG_DEBUG,"[TCSTATS] FOUND: lended = $lended, borrowed = $borrowed, giants = $giants");
my $interface = $taskData->{'Interface'};
my $timestamp = $taskData->{'Timestamp'};
# tokens: 64968 ctokens: 64750
} elsif ($stdout =~ / tokens/) {
# Stats ID to update
my $sid;
# Default to transmit statistics
my $direction = opentrafficshaper::plugins::statistics::STATISTICS_DIR_TX;
} elsif ($stdout eq "") {
# Is this a system class?
my $classChildDec = hex($stat->{'TCClassChild'});
# Check if this is a limit class...
if (opentrafficshaper::plugins::tc::isPoolTcClass($interface,$stat->{'TCClassParent'},$stat->{'TCClassChild'})) {
# If we don't have stats just return
if (!%{$stats}) {
return;
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->{'TCClassParent'},
$stat->{'TCClassChild'}
);
}
# Item to update
my $item;
# Is this a system class?
if ($stats->{'_class_parent'} == 1 && (my $classChildDec = hex($stats->{'_class_child'})) < 100) {
# Split off the different types of updates
if ($classChildDec == 1) {
$item = "main:${iface}:all";
} elsif ($classChildDec == 2) {
$item = "main:${iface}:classes";
} elsif ($classChildDec == 3) {
$item = "main:${iface}:besteffort";
} else {
$logger->log(LOG_WARN,"[TCSTATS] System traffic class '%s:%s' NOT FOUND",$stats->{'_class_parent'},$stats->{'_class_client'});
}
} else {
# Class = 1 is the root
# XXX: Should this be hard coded or used like TC_ROOT_CLASS is
if ($classChildDec == 1) {
# This is a special case case
$sid = opentrafficshaper::plugins::statistics::setSIDFromCID($interface,0);
} else {
$item = opentrafficshaper::plugins::tc::getUIDFromTcClass($stats->{'_class_child'});
if (!$item) {
$logger->log(LOG_WARN,"[TCSTATS] User for traffic class '%s:%s' NOT FOUND",$stats->{'_class_parent'},$stats->{'_class_client'});
# Save the class with the decimal number
if (my $classID = opentrafficshaper::plugins::tc::getCIDFromTcClass($interface,
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->{'TCClassParent'},
$stat->{'TCClassChild'}
);
}
}
}
# Make sure we have the uid now
if (defined($item)) {
# Build our submission, this is basically copying the hash
my %submission = %{$stats};
$submission{'timestamp'} = $timestamp;
$submission{'direction'} = $direction;
$logger->log(LOG_DEBUG,"[TCSTATS] Submitting stats for [%s]",$item);
$kernel->post("statistics" => "update" => $item => \%submission);
}
# Make sure we have the lid now
if (defined($sid)) {
# Build our submission
$stat->{'Timestamp'} = $timestamp;
$stat->{'Direction'} = $direction;
# Blank stats and start over
$stats = { };
$taskData->{'Stats'}->{$sid} = $stat;
}
}
# Child writes to STDERR
sub task_child_stderr
sub _task_child_stderr
{
my ($kernel,$heap,$stdout,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
my $child = $heap->{task_by_wid}->{$task_id};
my ($kernel,$heap,$stdout,$task_id) = @_[KERNEL,HEAP,ARG0,ARG1];
$logger->log(LOG_WARN,"[TCSTATS] TASK/$task_id: STDERR => ".$stdout);
my $task = $heap->{task_by_wid}->{$task_id};
$logger->log(LOG_WARN,"[TCSTATS] TASK/%s: STDERR => %s",$task_id,$stdout);
}
# Child closed its handles, it won't communicate with us, so remove it
sub task_child_close
sub _task_child_close
{
my ($kernel,$heap,$task_id) = @_[KERNEL,HEAP,ARG0];
my $child = delete($heap->{task_by_wid}->{$task_id});
my ($kernel,$heap,$task_id) = @_[KERNEL,HEAP,ARG0];
my $task = $heap->{task_by_wid}->{$task_id};
my $taskData = $heap->{'task_data'}->{$task_id};
# May have been reaped by task_sigchld()
if (!defined($child)) {
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/$task_id: Closed dead child");
# May have been reaped by task_sigchld()
if (!defined($task)) {
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/%s: Closed dead child",$task_id);
return;
}
}
# Push consolidated update through
$kernel->post("statistics" => "update" => $taskData->{'Stats'});
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/$task_id: Closed PID ".$child->PID);
delete($heap->{task_by_pid}->{$child->PID});
delete($heap->{task_by_pid}->{$task_id});
$logger->log(LOG_DEBUG,"[TCSTATS] TASK/%s: Closed PID %s",$task_id,$task->PID);
# Fire up next tick
$kernel->delay(tick => TICK_PERIOD);
# Cleanup
delete($heap->{task_by_pid}->{$task->PID});
delete($heap->{task_by_wid}->{$task_id});
delete($heap->{task_data}->{$task_id});
}
# Reap the dead child
sub task_sigchld
sub _task_handle_SIGCHLD
{
my ($kernel,$heap,$pid,$status) = @_[KERNEL,HEAP,ARG1,ARG2];
my $child = delete($heap->{task_by_pid}->{$pid});
my $task = $heap->{task_by_pid}->{$pid};
$logger->log(LOG_DEBUG,"[TCSTATS] TASK: Task with PID $pid exited with status $status");
$logger->log(LOG_DEBUG,"[TCSTATS] TASK: Task with PID %s exited with status %s",$pid,$status);
# May have been reaped by task_child_close()
return if (!defined($child));
# May have been reaped by task_child_close()
return if (!defined($task));
delete($heap->{task_by_wid}{$child->ID});
delete($heap->{task_data}{$child->ID});
# Cleanup
delete($heap->{task_by_pid}->{$pid});
delete($heap->{task_by_wid}->{$task->ID});
delete($heap->{task_data}->{$task->ID});
}
sub handle_SIGHUP
# Handle SIGINT
sub _task_handle_SIGINT
{
$logger->log(LOG_WARN,"[TCSTATS] Got SIGHUP, ignoring for now");
my ($kernel,$heap,$signal_name) = @_[KERNEL,HEAP,ARG0];
# Shutdown stdin on all children, this will terminate /sbin/tc
foreach my $task_id (keys %{$heap->{'task_by_wid'}}) {
my $task = $heap->{'task_by_wid'}{$task_id};
# $kernel->sig_child($task->PID, "asig_child");
# $task->kill("INT"); #NK: doesn't work
$kernel->post($task,"shutdown_stdin"); #NK: doesn't work
}
$logger->log(LOG_WARN,"[TCSTATS] Killed children processes");
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/FLOT.LASTUPDATE
View file @ efc9ebe1
2013-08-20
v0.8.1
2013-11-30
v0.8.2
cp flot/*.min.js static/flot/
opentrafficshaper/plugins/webserver/pages/configmanager.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: configmanager 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -32,26 +32,51 @@ our (@ISA,@EXPORT,@EXPORT_OK);
use DateTime;
use HTML::Entities;
use HTTP::Status qw( :constants );
use HTTP::Status qw(
:constants
);
use URI::Escape;
use awitpt::util qw(
isNumber ISNUMBER_ALLOW_ZERO
parseFormContent
parseURIQuery
prettyUndef
);
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::utils qw( parseFormContent isUsername isIP isNumber prettyUndef );
use opentrafficshaper::plugins::configmanager qw(
getInterfaces
getInterface
use opentrafficshaper::plugins::configmanager qw( getOverrides getOverride getTrafficClasses getTrafficClassName isTrafficClassValid );
getTrafficClass
getAllTrafficClasses
getInterfaceTrafficClass
getEffectiveInterfaceTrafficClass2
changeInterfaceTrafficClass
isInterfaceIDValid
isTrafficClassIDValid
);
# Sidebar menu options for this module
my $menu = {
'View Overrides' => {
'All Overrides' => '',
},
'Admin' => {
'Add Override' => 'add',
},
};
my $menu = [
{
'name' => 'Admin',
'items' => [
{
'name' => 'Configuration',
'link' => 'admin-config'
}
]
}
];
......@@ -61,431 +86,296 @@ sub default
my ($kernel,$globals,$client_session_id,$request) = @_;
my @overrides = getOverrides();
# Build content
my $content = "";
# Header
$content .=<<EOF;
<table class="table">
<legend>Override List</legend>
<thead>
<tr>
<th></th>
<th>Friendly Name</th>
<th>User</th>
<th>Group</th>
<th>IP</th>
<th>Expires</th>
<th></th>
<th>Class</th>
<th>CIR (Kbps)</th>
<th>Limit (Kbps)</th>
<th></th>
</tr>
</thead>
<tbody>
EOF
# Body
foreach my $oid (@overrides) {
my $override;
# If we can't get the limit just move onto the next
if (!defined($override = getOverride($oid))) {
next;
}
my $keyEscaped = uri_escape($override->{'Key'});
my $friendlyNameEncoded = prettyUndef(encode_entities($override->{'FriendlyName'}));
my $usernameEncoded = prettyUndef(encode_entities($override->{'Username'}));
my $ipAddress = prettyUndef($override->{'IP'});
my $expiresStr = DateTime->from_epoch( epoch => $override->{'Expires'} )->iso8601();
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'}));
$content .= <<EOF;
<tr>
<td></td>
<td>$friendlyNameEncoded</td>
<td>$usernameEncoded</td>
<td>$override->{'GroupID'}</td>
<td>$ipAddress</td>
<td>$expiresStr</td>
<td><span class="glyphicon glyphicon-arrow-right" /></td>
<td>$classStr</td>
<td>$cirStr</td>
<td>$limitStr</td>
<td>
<a href="/configmanager/override-edit?key=$keyEscaped"><span class="glyphicon glyphicon-wrench" /></a>
<a href="/configmanager/override-remove?key=$keyEscaped"><span class="glyphicon glyphicon-remove" /></a>
</td>
</tr>
EOF
}
# No results
if (!@overrides) {
$content .=<<EOF;
<tr class="info">
<td colspan="8"><p class="text-center">No Results</p></td>
</tr>
EOF
}
# Footer
$content .=<<EOF;
</tbody>
</table>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Add action
sub add
# Admin configuration
sub admin_config
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Setup our environment
my $logger = $globals->{'logger'};
# Grab stuff we need
my @interfaces = getInterfaces();
# Errors to display
# Errors to display above the form
my @errors;
# Form items
my $params = {
'inputFriendlyName' => undef,
'inputUsername' => undef,
'inputIP' => undef,
'inputTrafficClass' => undef,
'inputTrafficClassEnabled' => undef,
'inputLimitTx' => undef,
'inputLimitTxEnabled' => undef,
'inputLimitTxBurst' => undef,
'inputLimitTxBurstEnabled' => undef,
'inputLimitRx' => undef,
'inputLimitRxEnabled' => undef,
'inputLimitRxBurst' => undef,
'inputLimitRxBurstEnabled' => undef,
'inputExpires' => undef,
'inputExpiresModifier' => undef,
'inputNotes' => undef,
};
# Build content
my $content = "";
# Form header
$content .=<<EOF;
<legend>Interface Rate Setup</legend>
EOF
# Form data
my $formData;
# If this is a form try parse it
if ($request->method eq "POST") {
# Parse form data
$params = parseFormContent($request->content);
my $form = parseFormContent($request->content);
# If user pressed cancel, redirect
if (defined($params->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'limits');
}
# Loop with rate changes
my $rateChanges = { };
foreach my $elementName (keys %{$form}) {
my $rateChange = $form->{$elementName};
# Check POST data
my $friendlyName = $params->{'inputFriendlyName'};
# Make sure we have at least the username or IP
my $username = isUsername($params->{'inputUsername'});
my $ipAddress = isIP($params->{'inputIP'});
if (!defined($username) && !defined($ipAddress)) {
push(@errors,"IP Address and/or Username must be specified");
}
# If the traffic class is ticked, process it
my $trafficClass;
if (defined($params->{'inputTrafficClassEnabled'})) {
if (!defined($trafficClass = isTrafficClassValid($params->{'inputTrafficClass'}))) {
push(@errors,"Traffic class is not valid");
# Skip over blanks
if ($rateChange->{'value'} =~ /^\s*$/) {
next;
}
}
# Check TrafficLimitTx
my $trafficLimitTx;
if (defined($params->{'inputTrafficLimitTxEnabled'})) {
if (!defined($trafficLimitTx = isNumber($params->{'inputLimitTx'}))) {
push(@errors,"Download CIR is not valid");
# 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;
}
}
my $trafficLimitTxBurst;
if (defined($params->{'inputTrafficLimitTxBurstEnabled'})) {
if (!defined($trafficLimitTxBurst = isNumber($params->{'inputLimitTxBurst'}))) {
push(@errors,"Download limit is not valid");
# Check interface exists
if (!defined($interfaceID = isInterfaceIDValid($interfaceID))) {
push(@errors,"Invalid data received, interface ID is invalid");
last;
}
}
# Check TrafficLimitRx
my $trafficLimitRx;
if (defined($params->{'inputTrafficLimitRxEnabled'})) {
if (!defined($trafficLimitRx = isNumber($params->{'inputLimitRx'}))) {
push(@errors,"Upload CIR is not valid");
# 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;
}
}
my $trafficLimitRxBurst;
if (defined($params->{'inputTrafficLimitRxBurstEnabled'})) {
if (!defined($trafficLimitRxBurst = isNumber($params->{'inputLimitRxBurst'}))) {
push(@errors,"Upload limit is not valid");
# Check value is valid
if (!defined($rateChange->{'value'} = isNumber($rateChange->{'value'}))) {
push(@errors,"Invalid value received for interface [$interfaceID], class [$trafficClassID]");
last;
}
}
# Check that we actually have something to override
if (
!defined($trafficClass) &&
!defined($trafficLimitTx) && !defined($trafficLimitTxBurst) &&
!defined($trafficLimitRx) && !defined($trafficLimitRxBurst)
) {
push(@errors,"Something must be specified to override");
}
my $expires = 0;
if (defined($params->{'inputExpires'}) && $params->{'inputExpires'} ne "") {
if (!defined($expires = isNumber($params->{'inputExpires'}))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
# Check if its defined
if (defined($params->{'inputExpiresModifier'}) && $params->{'inputExpiresModifier'} ne "") {
# Minutes
if ($params->{'inputExpiresModifier'} eq "m") {
$expires *= 60;
# Hours
} elsif ($params->{'inputExpiresModifier'} eq "h") {
$expires *= 3600;
# Days
} elsif ($params->{'inputExpiresModifier'} eq "d") {
$expires *= 86400;
} else {
push(@errors,"Expires modifier is not valid");
}
$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);
}
# Set right time for expiry
$expires += time();
}
}
# Grab notes
my $notes = $params->{'inputNotes'};
# If there are no errors we need to push this override
if (!@errors) {
# Build override
my $override = {
'FriendlyName' => $friendlyName,
'Username' => $username,
'IP' => $ipAddress,
'GroupID' => 1,
'ClassID' => $trafficClass,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'Expires' => $expires,
'Notes' => $notes,
'Source' => "plugin.webserver.overrides",
};
# Throw the change at the config manager
$kernel->post("configmanager" => "process_override_change" => $override);
$logger->log(LOG_INFO,'[WEBSERVER/OVERRIDE/ADD] User: %s, IP: %s, Group: %s, Class: %s, Limits: %s/%s, Burst: %s/%s',
prettyUndef($username),
prettyUndef($ipAddress),
"",
prettyUndef($trafficClass),
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
);
return (HTTP_TEMPORARY_REDIRECT,'configmanager');
return (HTTP_TEMPORARY_REDIRECT,"/configmanager");
}
}
# Handle checkboxes first and a little differently
foreach my $item (
"inputTrafficClassEnabled",
"inputLimitTxEnabled","inputLimitTxBurstEnabled",
"inputLimitRxEnabled", "inputLimitRxBurstEnabled"
) {
$params->{$item} = defined($params->{$item}) ? "checked" : "";
}
# Sanitize params if we need to
foreach my $item (keys %{$params}) {
$params->{$item} = defined($params->{$item}) ? encode_entities($params->{$item}) : "";
}
# Build content
my $content = "";
# Form header
# Header
$content .=<<EOF;
<form role="form" method="post">
<legend>Add Override</legend>
<!-- 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">'.$error.'</div>';
$content .= '<div class="alert alert-danger">'.encode_entities($error).'</div>';
}
}
# Generate traffic class list
my $trafficClasses = getTrafficClasses();
my $trafficClassStr = "";
foreach my $classID (keys %{$trafficClasses}) {
# Process selections nicely
my $selected = "";
if ($params->{'inputTrafficClass'} ne "" && $params->{'inputTrafficClass'} eq $classID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$classID.'" '.$selected.'>'.$trafficClasses->{$classID}.'</option>';
}
# Interfaces tab setup
$content .=<<EOF;
<br />
<!-- Interface Tabs -->
<ul class="nav nav-tabs" id="configInterfaceTabs">
EOF
my $firstPaneActive = " active";
foreach my $interfaceID (@interfaces) {
my $interface = getInterface($interfaceID);
my $encodedInterfaceID = encode_entities($interfaceID);
my $encodedInterfaceName = encode_entities($interface->{'Name'});
# Header
$content .=<<EOF;
<li class="$firstPaneActive">
<a href="#interface$encodedInterfaceID" data-toggle="tab">
Interface: $encodedInterfaceName
</a>
</li>
EOF
# No longer the first pane
$firstPaneActive = "";
}
$content .=<<EOF;
<div class="form-group">
<label for="inputFriendlyName" class="col-lg-2 control-label">FriendlyName</label>
<div class="row">
<div class="col-lg-4">
<div class="input-group">
<input name="inputFriendlyName" type="text" placeholder="Friendly Name" class="form-control" value="$params->{'inputFriendlyName'}" />
<span class="input-group-addon">*</span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputUsername" class="col-lg-2 control-label">Username</label>
<div class="row">
<div class="col-lg-4">
<input name="inputUsername" type="text" placeholder="Username To Override" class="form-control" value="$params->{'inputUsername'}" />
</div>
</div>
</div>
<div class="form-group">
<label for="inputIP" class="col-lg-2 control-label">IP Address</label>
<div class="row">
<div class="col-lg-4">
<input name="inputIP" type="text" placeholder="And/Or IP Address To Override" class="form-control" value="$params->{'inputIP'}" />
</div>
</div>
</div>
</ul>
<!-- Tab panes -->
<div class="tab-content">
EOF
<div class="form-group">
<label for="inputTafficClass" class="col-lg-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-lg-2">
<input name="inputTrafficClassEnabled" type="checkbox" $params->{'inputTrafficClassEnabled'}/> Override
</div>
<div class="col-lg-2">
<select name="inputTrafficClass" placeholder="Traffic Class" class="form-control" value="$params->{'inputTrafficClass'}">
$trafficClassStr
</select>
</div>
</div>
</div>
# Suck in list of interfaces
$firstPaneActive = " active";
foreach my $interfaceID (@interfaces) {
my $interface = getInterface($interfaceID);
my $encodedInterfaceID = encode_entities($interfaceID);
my $encodedInterfaceName = encode_entities($interface->{'Name'});
<div class="form-group">
<label for="inputLimitTx" class="col-lg-2 control-label">Download CIR</label>
<div class="row">
<div class="col-lg-2">
<input name="inputLimitTxEnabled" type="checkbox" $params->{'inputLimitTxEnabled'}/> Override
</div>
# Root class
my $interfaceTrafficClass = getInterfaceTrafficClass($interfaceID,0);
my $effectiveInterfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClass->{'ID'});
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitTx" type="text" placeholder="Download CIR" class="form-control" value="$params->{'inputLimitTx'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
my $encodedInterfaceLimit = encode_entities($effectiveInterfaceTrafficClass->{'Limit'});
<div class="form-group">
<label for="inputLimitTxBurst" class="col-lg-2 control-label">Download Limit</label>
<div class="row">
<div class="col-lg-2">
<input name="inputLimitTxBurstEnabled" type="checkbox" $params->{'inputLimitTxBurstEnabled'}/> Override
</div>
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitTxBurst" type="text" placeholder="Download Limit" class="form-control" value="$params->{'inputLimitTxBurst'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputLimitRx" class="col-lg-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-lg-2">
<input name="inputLimitRxEnabled" type="checkbox" $params->{'inputLimitRxEnabled'}/> Override
</div>
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitRx" type="text" placeholder="Upload CIR" class="form-control" value="$params->{'inputLimitRx'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputLimitRxBurst" class="col-lg-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-lg-2">
<input name="inputLimitRxBurstEnabled" type="checkbox" $params->{'inputLimitRxBurstEnabled'}/> Override
</div>
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitRxBurst" type="text" placeholder="Upload Limit" class="form-control" value="$params->{'inputLimitRxBurst'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
# Interface tab
$content .=<<EOF;
<div class="tab-pane$firstPaneActive" id="interface$encodedInterfaceID">
EOF
# No longer the first pane
$firstPaneActive = "";
# Sanitize params if we need to
if (defined($formData->{"Limit[$encodedInterfaceID][0]"})) {
$formData->{"Limit[$encodedInterfaceID][0]"} =
encode_entities($formData->{"Limit[$encodedInterfaceID][0]"});
} else {
$formData->{"Limit[$encodedInterfaceID][0]"} = "";
}
<div class="form-group">
<label for="inputExpires" class="col-lg-2 control-label">Expires</label>
<div class="row">
<div class="col-lg-2">
<input name="inputExpires" type="text" placeholder="Expires" class="form-control" value="$params->{'inputExpires'}" />
</div>
<div class="col-lg-2">
<select name="inputExpiresModifier" placeholder="Expires Modifier" class="form-control" value="$params->{'inputExpiresModifier'}">
<option value="m">Mins</option>
<option value="h">Hours</option>
<option value="d">Days</option>
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="inputNotes" class="col-lg-2 control-label">Notes</label>
<div class="row">
<div class="col-lg-4">
<textarea name="inputNotes" placeholder="Notes" rows="3" class="form-control"></textarea>
#
# Form header
#
$content .=<<EOF;
<form role="form" method="post">
EOF
#
# Page content
#
$content .=<<EOF;
<br />
<legend>Main: $encodedInterfaceName</legend>
<div class="form-group">
<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="Limit[$encodedInterfaceID][0]" type="text"
placeholder="$encodedInterfaceLimit" class="form-control"
value="$formData->{"Limit[$encodedInterfaceID][0]"}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
EOF
# 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: $encodedInterfaceName - $encodedTrafficClassName</legend>
<div class="form-group">
<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="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="TxLimit" class="col-md-1 control-label">Limit</label>
<div class="col-md-3">
<div class="input-group">
<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>
</div>
</div>
EOF
}
$content .=<<EOF;
<div class="form-group">
<button type="submit" class="btn btn-primary">Update</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
# Footer
$content .=<<EOF;
</div>
EOF
}
$content .=<<EOF;
</div>
</div>
EOF
$content .=<<EOF;
</div>
</div>
<div class="form-group">
<button type="submit" class="btn btn-primary">Add</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/index.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: index 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -29,21 +29,29 @@ our (@ISA,@EXPORT,@EXPORT_OK);
@EXPORT_OK = qw(
);
use HTTP::Status qw( :constants );
use opentrafficshaper::plugins;
# Dashboard
sub _catchall
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Build content
my $content = "";
my ($res,$content,$opts);
$content .= "Hi there: ".$request->uri->as_string();
if (!isPluginLoaded('statistics')) {
$content .= "No Statistics Plugin";
$res = HTTP_OK;
goto END;
}
return (200,$content);
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-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
# the Free Software Foundation, either version 3 of the License, or
......@@ -32,38 +32,113 @@ our (@ISA,@EXPORT,@EXPORT_OK);
use DateTime;
use HTML::Entities;
use HTTP::Status qw( :constants );
use URI::Escape;
use HTTP::Status qw(
:constants
);
use NetAddr::IP;
use URI::Escape qw(
uri_escape
);
use URI::QueryParam;
use Storable qw(
dclone
);
use awitpt::util qw(
parseURIQuery
parseFormContent
isUsername ISUSERNAME_ALLOW_ATSIGN
isNumber ISNUMBER_ALLOW_ZERO
prettyUndef
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::plugins;
use opentrafficshaper::utils qw( parseURIQuery parseFormContent isUsername isIP isNumber prettyUndef );
use opentrafficshaper::plugins::configmanager qw(
getPools
getPool
getPoolByName
getPoolShaperState
isPoolOverridden
isPoolReady
getPoolMembers
getPoolMember
getAllPoolMembersByInterfaceGroupIP
getPoolMemberShaperState
isPoolMemberReady
getPoolOverrides
getPoolOverride
getInterfaceGroup
getInterfaceGroups
isInterfaceGroupIDValid
use opentrafficshaper::plugins::configmanager qw( getLimits getLimit getTrafficClasses getTrafficClassName isTrafficClassValid );
getMatchPriorities
isMatchPriorityIDValid
getTrafficClass
getTrafficClasses
isTrafficClassIDValid
);
use opentrafficshaper::util qw(
isIPv46 isIPv46CIDR
);
# Sidebar menu options for this module
my $menu = {
'View Limits' => {
'All Limits' => '',
'Manual Limits' => './?source=plugin.webserver.limits',
my $menu = [
{
'name' => 'Pools',
'items' => [
{
'name' => 'List Pools',
'link' => 'pool-list'
},
{
'name' => 'List Manual Pools',
'link' => 'pool-list?source=plugin.webserver.limits'
},
{
'name' => 'Add Pool',
'link' => 'pool-add'
}
]
},
'Admin' => {
'Add Limit' => 'add',
{
'name' => 'Pool Overrides',
'items' => [
{
'name' => 'List Overrides',
'link' => 'pool-override-list'
},
{
'name' => 'Add Override',
'link' => 'pool-override-add'
}
]
},
};
{
'name' => 'Admin',
'items' => [
{
'name' => 'Add Limit',
'link' => 'limit-add'
}
]
}
];
# Default page/action
sub default
# Pool list page/action
sub pool_list
{
my ($kernel,$globals,$client_session_id,$request) = @_;
my @limits = getLimits();
my @pools = getPools();
# Pull in URL params
my $queryParams = parseURIQuery($request);
......@@ -73,181 +148,131 @@ sub default
# Header
$content .=<<EOF;
<table class="table">
<legend>Limit List</legend>
<thead>
<tr>
<th></th>
<th>User</th>
<th>IP</th>
<th>Class</th>
<th>Group</th>
<th>CIR (Kbps)</th>
<th>Limits (Kbps)</th>
<th></th>
</tr>
</thead>
<tbody>
<legend>Pool List</legend>
<table class="table">
<thead>
<tr>
<th></th>
<th>Friendly Name</th>
<th>Name</th>
<th>Expires</th>
<th>Members</th>
<th></th>
<th>Class</th>
<th>CIR (Kbps)</th>
<th>Limit (Kbps)</th>
<th></th>
</tr>
</thead>
<tbody>
EOF
# Body
foreach my $lid (@limits) {
my $limit;
# If we can't get the limit just move onto the next
if (!defined($limit = getLimit($lid))) {
foreach my $pid (@pools) {
my $pool;
# If we can't get the pool just move onto the next
if (!defined($pool = getPool($pid))) {
next;
}
# Conditionals
if (defined($queryParams->{'source'})) {
if ($limit->{'Source'} ne $queryParams->{'source'}) {
if ($pool->{'Source'} ne $queryParams->{'source'}->{'value'}) {
next;
}
}
# Make style a bit pretty
my $style = "";
my $icon = "";
if ($limit->{'Status'} eq "offline") {
$icon = '<span class="glyphicon glyphicon-trash"></span>';
$style = "warning";
} elsif ($limit->{'Status'} eq "new") {
# $icon = '<i class="glyphicon-plus"></i>';
$style = "info";
} elsif ($limit->{'Status'} eq "conflict") {
$icon = '<span class="glyphicon glyphicon-random"></span>';
$style = "error";
}
# Get a nice last update string
my $lastUpdate = DateTime->from_epoch( epoch => $limit->{'LastUpdate'} )->iso8601();
my $lastUpdate = DateTime->from_epoch( epoch => $pool->{'LastUpdate'} )->iso8601();
my $cirStr = sprintf('%s/%s',prettyUndef($limit->{'TrafficLimitTx'}),prettyUndef($limit->{'TrafficLimitRx'}));
my $limitStr = sprintf('%s/%s',prettyUndef($limit->{'TrafficLimitTxBurst'}),prettyUndef($limit->{'TrafficLimitRxBurst'}));
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'});
# If the statistics plugin is loaded pull in some stats
my $statsPPSTx = my $statsRateTx = my $statsPrioTx = "-";
my $statsPPSRx = my $statsRateRx = my $statsPrioRx = "-";
if (plugin_is_loaded('statistics')) {
my $stats = opentrafficshaper::plugins::statistics::getLastStats($limit->{'Username'});
# Pull off tx stats
if (my $statsTx = $stats->{'tx'}) {
$statsPPSTx = $statsTx->{'current_pps'};
$statsRateTx = $statsTx->{'current_rate'};
$statsPrioTx = $statsTx->{'priority'};
}
# Pull off rx stats
if (my $statsRx = $stats->{'rx'}) {
$statsPPSRx = $statsRx->{'current_pps'};
$statsRateRx = $statsRx->{'current_rate'};
$statsPrioRx = $statsRx->{'priority'};
}
}
my $poolExpiresStr = encode_entities(
($pool->{'Expires'} > 0) ? DateTime->from_epoch( epoch => $pool->{'Expires'} )->iso8601() : '-never-'
);
my $poolMemberCount = getPoolMembers($pool->{'ID'});
my $usernameEncoded = encode_entities($limit->{'Username'});
my $usernameEscaped = uri_escape($limit->{'Username'});
my $classStr = getTrafficClassName($limit->{'ClassID'});
my $trafficClass = getTrafficClass($pool->{'TrafficClassID'});
my $trafficClassNameEncoded = encode_entities($trafficClass->{'Name'});
# Display relevant icons depending on pool status
my $icons = "";
if (getPoolShaperState($pool->{'ID'}) & SHAPER_NOTLIVE || $pool->{'Status'} == CFGM_CHANGED) {
$icons .= '<span class="glyphicon glyphicon-time" />';
}
if ($pool->{'Status'} == CFGM_NEW) {
$icons .= '<span class="glyphicon glyphicon-import" />';
}
if ($pool->{'Status'} == CFGM_OFFLINE) {
$icons .= '<span class="glyphicon glyphicon-trash" />';
}
# if ($pool->{'Status'} eq 'conflict') {
# $icons .= '<span class="glyphicon glyphicon-random" />';
# }
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 class="$style">
<td>$icon</td>
<td class="limit">
$usernameEncoded
<span class="limit-data" style="display:none">
<table width="100%" border="0">
<tr>
<td>Source</td>
<td>$limit->{'Source'}</td>
<td>&nbsp;</td>
<td>Last Update</td>
<td>$lastUpdate</td>
</tr>
<tr>
<td>Tx Priority</td>
<td>$statsPrioTx</td>
<td>&nbsp;</td>
<td>Tx Priority</td>
<td>$statsPrioRx</td>
</tr>
<tr>
<td>Tx PPS</td>
<td>$statsPPSTx</td>
<td>&nbsp;</td>
<td>Rx PPS</td>
<td>$statsPPSRx</td>
</tr>
<tr>
<td>Tx Rate</td>
<td>$statsRateTx</td>
<td>&nbsp;</td>
<td>Rx Rate</td>
<td>$statsRateRx</td>
</tr>
</table>
</span>
</td>
<td>$limit->{'IP'}</td>
<td>$classStr</td>
<td>$limit->{'GroupID'}</td>
<td>$cirStr</td>
<td>$limitStr</td>
<td>
<a href="/statistics/by-username?username=$usernameEscaped"><span class="glyphicon glyphicon-stats"></span></a>
<a href="/limits/limit-edit?username=$usernameEscaped"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="/limits/limit-remove?username=$usernameEscaped"><span class="glyphicon glyphicon-remove"></span></a>
</td>
</tr>
<tr>
<td>$icons</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 class="align-center">$trafficClassNameEncoded</td>
<td class="align-center">$poolCIRStr</td>
<td class="align-center">$poolLimitStr</td>
<td>
<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
}
# No results
if (!@limits) {
if (!@pools) {
$content .=<<EOF;
<tr class="info">
<td colspan="8"><p class="text-center">No Results</p></td>
</tr>
<tr class="info">
<td colspan="10"><p class="text-center">No Results</p></td>
</tr>
EOF
}
# Footer
$content .=<<EOF;
</tbody>
</table>
EOF
my $style = <<EOF;
.popover {
max-width:none;
}
.popover td:nth-child(4), .popover td:first-child {
font-weight:bold;
text-transform:capitalize;
}
EOF
my $javascript = <<EOF;
\$(document).ready(function(){
\$('.limit').each(function(){
\$(this).popover({
html: true,
content: \$(this).find('.limit-data').html(),
placement: 'bottom',
trigger: 'hover',
container: \$(this),
title: 'Statistics',
});
})
});
</tbody>
</table>
<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
return (HTTP_OK,$content,{ 'style' => $style, 'menu' => $menu, 'javascript' => $javascript });
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Add action
sub add
# Pool add/edit action
sub pool_addedit
{
my ($kernel,$globals,$client_session_id,$request) = @_;
......@@ -255,128 +280,214 @@ sub add
# Setup our environment
my $logger = $globals->{'logger'};
# Errors to display
# Errors to display above the form
my @errors;
# Form items
my $params = {
'inputFriendlyName' => undef,
'inputUsername' => undef,
'inputIP' => undef,
'inputTrafficClass' => undef,
'inputLimitTx' => undef,
'inputLimitTxBurst' => undef,
'inputLimitRx' => undef,
'inputLimitRxBurst' => undef,
'inputExpires' => undef,
'inputExpiresModifier' => undef,
'inputNotes' => undef,
# Items for our form...
my @formElements = qw(
FriendlyName
Name
InterfaceGroupID
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
# Expires modifier options
my $expiresModifiers = {
'm' => "Minutes",
'h' => "Hours",
'd' => "Days",
'n' => "Never",
};
# Title of the form, by default its an add form
my $formType = "Add";
my $formNoEdit = "";
# Form data
my $formData;
# If we have a pool, this is where its kept
my $pool;
# Get query params
my $queryParams = parseURIQuery($request);
# If we have a pool ID, pull in the pool
if (defined($queryParams->{'pid'})) {
# Check if we can grab the pool
if (!defined($pool = getPool($queryParams->{'pid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
}
# If this is a form try parse it
if ($request->method eq "POST") {
# Parse form data
$params = parseFormContent($request->content);
my $form = parseFormContent($request->content);
# If user pressed cancel, redirect
if (defined($params->{'cancel'})) {
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
foreach my $key (keys %{$form}) {
$formData->{$key} = $form->{$key}->{'value'};
}
# Set form type if its edit
if (defined($form->{'submit'}) && $form->{'submit'}->{'value'} eq "Edit") {
# Check pool exists
if (!defined($pool)) {
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
$formData->{'ID'} = $pool->{'ID'};
$formType = "Edit";
$formNoEdit = "readonly";
}
# Maybe we were given a pool key as a parameter? this would be an edit form
} elsif ($request->method eq "GET") {
if (defined($pool)) {
# Setup form data from pool
foreach my $key (@formElements) {
$formData->{$key} = $pool->{$key};
}
$formType = "Edit";
$formNoEdit = "readonly";
# Woops ... no query string?
} elsif (keys %{$queryParams} > 0) {
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
# We only do this if we have hash elements
if (ref($formData) eq "HASH") {
# Grab friendly name
my $friendlyName = $params->{'inputFriendlyName'};
my $friendlyName = $formData->{'FriendlyName'};
# Check POST data
my $username;
if (!defined($username = isUsername($params->{'inputUsername'}))) {
push(@errors,"Username is not valid");
my $name;
if (!defined($name = isUsername($formData->{'Name'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Name is not valid");
}
my $ipAddress;
if (!defined($ipAddress = isIP($params->{'inputIP'}))) {
push(@errors,"IP address is not valid");
my $interfaceGroupID;
if (!defined($interfaceGroupID = isInterfaceGroupIDValid($formData->{'InterfaceGroupID'}))) {
push(@errors,"Interface group is not valid");
}
my $trafficClass;
if (!defined($trafficClass = isTrafficClassValid($params->{'inputTrafficClass'}))) {
if ($formType ne "Edit" && getPoolByName($interfaceGroupID,$name)) {
push(@errors,"A pool with the same name already exists");
}
my $trafficClassID;
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
my $trafficLimitTx = isNumber($params->{'inputLimitTx'});
my $trafficLimitTxBurst = isNumber($params->{'inputLimitTxBurst'});
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($params->{'inputLimitRx'});
my $trafficLimitRxBurst = isNumber($params->{'inputLimitRxBurst'});
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");
}
# Make sure pool is not transitioning states
if ($formType eq "Edit") {
if (!isPoolReady($pool->{'ID'})) {
push(@errors,"Pool is not currently in a READY state, please try again");
}
}
my $expires = 0;
if (defined($params->{'inputExpires'}) && $params->{'inputExpires'} ne "") {
if (!defined($expires = isNumber($params->{'inputExpires'}))) {
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
# Check if its defined
if (defined($params->{'inputExpiresModifier'}) && $params->{'inputExpiresModifier'} ne "") {
# Minutes
if ($params->{'inputExpiresModifier'} eq "m") {
if (defined($formData->{'inputExpires.modifier'}) && $formData->{'inputExpires.modifier'} ne "") {
# Never
if ($formData->{'inputExpires.modifier'} eq "n") {
$expires = 0;
} elsif ($formData->{'inputExpires.modifier'} eq "m") {
$expires *= 60;
# Hours
} elsif ($params->{'inputExpiresModifier'} eq "h") {
} elsif ($formData->{'inputExpires.modifier'} eq "h") {
$expires *= 3600;
# Days
} elsif ($params->{'inputExpiresModifier'} eq "d") {
} elsif ($formData->{'inputExpires.modifier'} eq "d") {
$expires *= 86400;
} else {
push(@errors,"Expires modifier is not valid");
}
}
# Set right time for expiry
$expires += time();
# Base the expiry off now, plus the expiry time
if ($expires > 0) {
$expires += time();
}
}
}
# Grab notes
my $notes = $params->{'inputNotes'};
my $notes = $formData->{'Notes'};
# If there are no errors we need to push this update
if (!@errors) {
# Build limit
my $limit = {
if (!@errors && $request->method eq "POST") {
# Build pool details
my $poolData = {
'FriendlyName' => $friendlyName,
'Username' => $username,
'IP' => $ipAddress,
'GroupID' => 1,
'ClassID' => $trafficClass,
'TrafficLimitTx' => $trafficLimitTx,
'TrafficLimitTxBurst' => $trafficLimitTxBurst,
'TrafficLimitRx' => $trafficLimitRx,
'TrafficLimitRxBurst' => $trafficLimitRxBurst,
'Name' => $name,
'InterfaceGroupID' => $interfaceGroupID,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
'Source' => "plugin.webserver.limits",
};
# Throw the change at the config manager
$kernel->post("configmanager" => "process_limit_change" => $limit);
my $cEvent;
if ($formType eq "Add") {
$poolData->{'Status'} = CFGM_ONLINE;
$poolData->{'Source'} = 'plugin.webserver.limits';
$cEvent = "pool_add";
} else {
$poolData->{'ID'} = $formData->{'ID'};
$cEvent = "pool_change";
}
$logger->log(LOG_INFO,'[WEBSERVER/LIMITS/ADD] User: %s, IP: %s, Group: %s, Class: %s, Limits: %s/%s, Burst: %s/%s',
prettyUndef($username),
prettyUndef($ipAddress),
undef,
prettyUndef($trafficClass),
prettyUndef($trafficLimitTx),
prettyUndef($trafficLimitRx),
prettyUndef($trafficLimitTxBurst),
prettyUndef($trafficLimitRxBurst)
$kernel->post("configmanager" => $cEvent => $poolData);
$logger->log(LOG_INFO,"[WEBSERVER/LIMITS] Pool: %s, Name: %s, InterfaceGroup: %s, Class: %s, Limits: %s/%s, ".
"Burst: %s/%s",
$formType,
prettyUndef($name),
prettyUndef($interfaceGroupID),
prettyUndef($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'limits');
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
# Sanitize params if we need to
foreach my $item (keys %{$params}) {
$params->{$item} = defined($params->{$item}) ? encode_entities($params->{$item}) : "";
foreach my $item (@formElements) {
$formData->{$item} = defined($formData->{$item}) ? encode_entities($formData->{$item}) : "";
}
# Build content
......@@ -384,134 +495,2062 @@ sub add
# Form header
$content .=<<EOF;
<form role="form" method="post">
<legend>Add Manual Limit</legend>
<legend>$formType Pool</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 interface group list
my @interfaceGroups = sort(getInterfaceGroups());
my $interfaceGroupStr = "";
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="'.$interfaceGroupIDEncoded.'" '.$selected.'>'.
$interfaceGroupNameEncoded.'</option>';
}
# Generate traffic class list
my $trafficClasses = getTrafficClasses();
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $classID (sort keys %{$trafficClasses}) {
$trafficClassStr .= '<option value="'.$classID.'">'.$trafficClasses->{$classID}.'</option>';
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->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$trafficClassIDEncoded.'" '.$selected.'>'.$trafficClassNameEncoded.'</option>';
}
# Header
# Generate expires modifiers list
my $expiresModifierStr = "";
foreach my $expireModifier (sort keys %{$expiresModifiers}) {
# Process selections nicely
my $selected = "";
if ($formData->{'inputExpires.modifier'} ne "" && $formData->{'inputExpires.modifier'} eq $expireModifier) {
$selected = "selected";
}
# Default to n if nothing is specified
if ($formData->{'inputExpires.modifier'} eq "" && $expireModifier eq "n") {
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# Blank expires if its 0
if (defined($formData->{'Expires'}) && $formData->{'Expires'} eq "0") {
$formData->{'Expires'} = "";
}
# Page content
$content .=<<EOF;
<div class="form-group">
<label for="inputFriendlyName" class="col-lg-2 control-label">Friendly Name</label>
<div class="row">
<div class="col-lg-4 input-group">
<input name="inputFriendlyName" type="text" placeholder="Opt. Friendly Name" class="form-control" value="$params->{'inputFriendlyName'}" />
<div class="form-group">
<label for="FriendlyName" class="col-md-2 control-label">Friendly Name</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="FriendlyName" type="text" placeholder="Opt. Friendly Name" class="form-control"
value="$formData->{'FriendlyName'}" />
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputUsername" class="col-lg-2 control-label">Username</label>
<div class="row">
<div class="col-lg-4 input-group">
<input name="inputUsername" type="text" placeholder="Username" class="form-control" value="$params->{'inputUsername'}" />
<span class="input-group-addon">*</span>
<div class="form-group">
<label for="Name" class="col-md-2 control-label">Name</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="Name" type="text" placeholder="Name" class="form-control"
value="$formData->{'Name'}" $formNoEdit />
<span class="input-group-addon">*</span>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputIP" class="col-lg-2 control-label">IP Address</label>
<div class="row">
<div class="col-lg-4 input-group">
<input name="inputIP" type="text" placeholder="IP Address" class="form-control" value="$params->{'inputIP'}" />
<span class="input-group-addon">*</span>
<div class="form-group">
<label for="InterfaceGroupID" class="col-md-2 control-label">Interface Group</label>
<div class="row">
<div class="col-md-2">
<select name="InterfaceGroupID" class="form-control" $formNoEdit>
$interfaceGroupStr
</select>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputTafficClass" class="col-lg-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-lg-2">
<select name="inputTrafficClass" placeholder="Traffic Class" class="form-control" value="$params->{'inputTrafficClass'}">
$trafficClassStr
</select>
<div class="form-group">
<label for="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-2">
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputExpires" class="col-lg-2 control-label">Expires</label>
<div class="row">
<div class="col-lg-2">
<input name="inputExpires" type="text" placeholder="Opt. Expires" class="form-control" value="$params->{'inputExpires'}" />
</div>
<div class="col-lg-2">
<select name="inputExpiresModifier" placeholder="Expires Modifier" class="form-control" value="$params->{'inputExpiresModifier'}">
<option value="m">Mins</option>
<option value="h">Hours</option>
<option value="d">Days</option>
</select>
<div class="form-group">
<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="TxCIR" type="text" placeholder="Download CIR" class="form-control"
value="$formData->{'TxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputLimitTx" class="col-lg-2 control-label">Download CIR</label>
<div class="row">
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitTx" type="text" placeholder="Download CIR" class="form-control" value="$params->{'inputLimitTx'}" />
<span class="input-group-addon">Kbps *<span>
<div class="form-group">
<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="TxLimit" type="text" placeholder="Download Limit" class="form-control"
value="$formData->{'TxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<label for="inputLimitTxBurst" class="col-lg-1 control-label">Limit</label>
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitTxBurst" type="text" placeholder="Download Limit" class="form-control" value="$params->{'inputLimitTxBurst'}" />
<span class="input-group-addon">Kbps<span>
<div class="form-group">
<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="RxCIR" type="text" placeholder="Upload CIR" class="form-control"
value="$formData->{'RxCIR'}" />
<span class="input-group-addon">Kbps *<span>
</div>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputLimitRx" class="col-lg-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitRx" type="text" placeholder="Upload CIR" class="form-control" value="$params->{'inputLimitRx'}" />
<span class="input-group-addon">Kbps *<span>
<div class="form-group">
<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="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<label for="inputLimitRxBurst" class="col-lg-1 control-label">Limit</label>
<div class="col-lg-3">
<div class="input-group">
<input name="inputLimitRxBurst" type="text" placeholder="Upload Limit" class="form-control" value="$params->{'inputLimitRxBurst'}" />
<span class="input-group-addon">Kbps<span>
<div class="form-group">
<label for="Expires" class="col-md-2 control-label">Expires</label>
<div class="row">
<div class="col-md-2">
<input name="Expires" type="text" placeholder="Optional" class="form-control"
value="$formData->{'Expires'}" />
</div>
<div class="col-md-2">
<select name="inputExpires.modifier" class="form-control" value="$formData->{'inputExpires.modifier'}">
$expiresModifierStr
</select>
</div>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="inputNotes" class="col-lg-2 control-label">Notes</label>
<div class="row">
<div class="col-lg-4">
<textarea name="inputNotes" placeholder="Opt. Notes" rows="3" class="form-control"></textarea>
<div class="form-group">
<label for="Notes" class="col-md-2 control-label">Notes</label>
<div class="row">
<div class="col-md-4">
<textarea name="Notes" placeholder="Opt. Notes" rows="3"
class="form-control">$formData->{'Notes'}</textarea>
</div>
</div>
</div>
<div class="form-group">
<button name="submit" type="submit" value="$formType" class="btn btn-primary">$formType</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Pool remove action
sub pool_remove
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Content to return
my $content = "";
# Pull in query data
my $queryParams = parseURIQuery($request);
# We need a key first of all...
if (!defined($queryParams->{'pid'})) {
$content = <<EOF;
<div class="alert alert-danger text-center">
No pool ID in query string!
</div>
EOF
goto END;
}
# Grab the pool
my $pool = getPool($queryParams->{'pid'}->{'value'});
# Make sure the pool ID is valid... we would have a pool now if it was
if (!defined($pool)) {
$content = <<EOF;
<div class="alert alert-danger text-center">
Invalid pool ID!
</div>
EOF
goto END;
}
# Make sure its a manual pool we're removing
if ($pool->{'Source'} ne "plugin.webserver.limits") {
$content = <<EOF;
<div class="alert alert-danger text-center">
Only manual pools can be removed!
</div>
</div>
</div>
<div class="form-group">
<button type="submit" class="btn btn-primary">Add</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
goto END;
}
# Pull in POST
my $form = parseFormContent($request->content);
# If this is a post, then its probably a confirmation
if (defined($form->{'confirm'})) {
# Check if its a success
if ($form->{'confirm'}->{'value'} eq "Yes") {
# Post the removal
$kernel->post("configmanager" => "pool_remove" => $pool->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Make the friendly name HTML safe
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 "$encodedPoolName"?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
<input type="submit" class="btn btn-default" name="confirm" value="No" />
</form>
EOF
# And here is where we return
END:
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Pool member list page/action
sub poolmember_list
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Build content
my $content = "";
# Build custom menu
my $customMenu = $menu;
# Pull in query params
my $queryParams = parseURIQuery($request);
# We need a key first of all...
if (!defined($queryParams->{'pid'})) {
$content = <<EOF;
<div class="alert alert-danger text-center">
No pool ID in query string!
</div>
EOF
goto END;
}
# Grab the pool
my $pool = getPool($queryParams->{'pid'}->{'value'});
# If pool is not defined, it means we got an invalid pool ID
if (!defined($pool)) {
$content = <<EOF;
<div class="alert alert-danger text-center">
Invalid pool ID!
</div>
EOF
goto END;
}
# Grab pools members
my @poolMembers = getPoolMembers($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 = [
{
'name' => 'Pool Members',
'items' => [
{
'name' => 'Add Pool Member',
'link' => $urlPoolMemberAdd
},
],
},
@{$menu}
];
# Header
$content .=<<EOF;
<legend>
<a href="pool-list"><span class="glyphicon glyphicon-circle-arrow-left"></span></a>
Pool Member List: '$poolFriendlyNameEncoded' [$poolNameEncoded]
</legend>
<table class="table">
<thead>
<tr>
<th></th>
<th>Friendly Name</th>
<th>Username</th>
<th>IP</th>
<th>NAT</th>
<th>Created</th>
<th>Updated</th>
<th>Expires</th>
<th></th>
</tr>
</thead>
<tbody>
EOF
# Body
foreach my $pmid (@poolMembers) {
my $poolMember;
# If we can't get the pool member just move onto the next
if (!defined($poolMember = getPoolMember($pmid))) {
next;
}
# Get a nice last update string
my $poolMemberFriendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
$poolMember->{'FriendlyName'} : $poolMember->{'Username'};
my $poolMemberFriendlyNameEncoded = encode_entities($poolMemberFriendlyName);
my $poolMemberUsernameEncoded = 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 $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 $poolMemberShaperState = getPoolMemberShaperState($poolMember->{'ID'});
# Display relevant icons depending on pool status
my $icons = "";
if (!($poolMemberShaperState & SHAPER_LIVE)) {
$icons .= '<span class="glyphicon glyphicon-time" />';
}
if ($poolMember->{'Status'} == CFGM_NEW) {
$icons .= '<span class="glyphicon glyphicon-import" />';
}
if ($poolMember->{'Status'} == CFGM_OFFLINE) {
$icons .= '<span class="glyphicon glyphicon-trash" />';
}
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>$poolMemberFriendlyNameEncoded</td>
<td>$poolMemberUsernameEncoded</td>
<td>$poolMemberIPEncoded</td>
<td>$natIcons$poolMemberIPNATEncoded</td>
<td>$poolMemberCreatedStr</td>
<td>$poolMemberUpdatedStr</td>
<td>$poolMemberExpiresStr</td>
<td>
<a href="$urlPoolMemberEdit"><span class="glyphicon glyphicon-wrench"></span></a>
<a href="$urlPoolMemberRemove"><span class="glyphicon glyphicon-remove"></span></a>
</td>
</tr>
EOF
}
# No results
if (!@poolMembers) {
$content .=<<EOF;
<tr class="info">
<td colspan="8"><p class="text-center">No Results</p></td>
</tr>
EOF
}
# Footer
$content .=<<EOF;
</tbody>
</table>
<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
END:
return (HTTP_OK,$content,{ 'menu' => $customMenu });
}
# Pool member add/edit action
sub poolmember_addedit
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Setup our environment
my $logger = $globals->{'logger'};
# Errors to display above the form
my @errors;
# Items for our form...
my @formElements = qw(
FriendlyName
Username IPAddress IPNATAddress IPNATInbound
MatchPriorityID
Expires inputExpires.modifier
Notes
);
# Expires modifier options
my $expiresModifiers = {
'm' => "Minutes",
'h' => "Hours",
'd' => "Days",
'n' => "Never",
};
# Title of the form, by default its an add form
my $formType = "Add";
my $formNoEdit = "";
my $checkboxNoEdit = "";
# Form data
my $formData;
# Pool
my $pool;
my $poolMember;
# Parse query params
my $queryParams = parseURIQuery($request);
# If we have a pool member ID, pull in the pool member
if (defined($queryParams->{'pmid'})) {
# Check if we can grab the pool member
if (!defined($poolMember = getPoolMember($queryParams->{'pmid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
$pool = getPool($poolMember->{'PoolID'});
# If we have a pool ID, pull in the pool
} elsif (defined($queryParams->{'pid'})) {
# Check if we can grab the pool
if (!defined($pool = getPool($queryParams->{'pid'}->{'value'}))) {
return (HTTP_TEMPORARY_REDIRECT,"/limits");
}
}
# If this is a form try parse it
if ($request->method eq "POST") {
# Parse form data
my $form = parseFormContent($request->content);
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# If the pool member is defined, rededirect to pool member list
if (defined($poolMember)) {
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
# Do same for pool
} elsif (defined($pool)) {
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
}
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
foreach my $key (keys %{$form}) {
$formData->{$key} = $form->{$key}->{'value'};
}
# Set form type if its edit
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');
}
$formData->{'ID'} = $poolMember->{'ID'};
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
}
# 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)) {
# Setup form data from pool member
foreach my $key (@formElements) {
$formData->{$key} = $poolMember->{$key};
}
# 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');
}
}
if (ref($formData) eq "HASH") {
# Grab friendly name
my $friendlyName = $formData->{'FriendlyName'};
# Check POST data
my $username;
if (!defined($username = isUsername($formData->{'Username'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Username is not valid");
}
my $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");
}
if ($formType eq "Add") {
if (getAllPoolMembersByInterfaceGroupIP($pool->{'InterfaceGroupID'},$ipAddress)) {
push(@errors,"A pool member with the same IP address already exists");
}
} elsif ($formType eq "Edit") {
if (!isPoolMemberReady($poolMember->{'ID'})) {
push(@errors,"Pool member is not currently in a READY state, please try again");
}
}
my $expires = 0;
if (defined($formData->{'Expires'}) && $formData->{'Expires'} ne "") {
if (!defined($expires = isNumber($formData->{'Expires'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
# Check if its defined
if (defined($formData->{'inputExpires.modifier'}) && $formData->{'inputExpires.modifier'} ne "") {
# Never
if ($formData->{'inputExpires.modifier'} eq "n") {
$expires = 0;
} elsif ($formData->{'inputExpires.modifier'} eq "m") {
$expires *= 60;
# Hours
} elsif ($formData->{'inputExpires.modifier'} eq "h") {
$expires *= 3600;
# Days
} elsif ($formData->{'inputExpires.modifier'} eq "d") {
$expires *= 86400;
} else {
push(@errors,"Expires modifier is not valid");
}
}
# Base the expiry off now, plus the expiry time
if ($expires > 0) {
$expires += time();
}
}
}
# Grab notes
my $notes = $formData->{'Notes'};
# If there are no errors we need to push this update
if (!@errors && $request->method eq "POST") {
# Build limit
my $poolMemberData = {
'FriendlyName' => $friendlyName,
'Username' => $username,
'IPAddress' => $ipAddress,
'IPNATAddress' => $ipNATAddress,
'IPNATInbound' => $ipNATInbound,
'GroupID' => 1,
'MatchPriorityID' => $matchPriorityID,
'Expires' => $expires,
'Notes' => $notes,
};
my $cEvent;
if ($formType eq "Add") {
$poolMemberData->{'PoolID'} = $pool->{'ID'};
$poolMemberData->{'Source'} = 'plugin.webserver.limits';
$cEvent = "poolmember_add";
} else {
$poolMemberData->{'ID'} = $poolMember->{'ID'};
$cEvent = "poolmember_change";
}
$kernel->post("configmanager" => $cEvent => $poolMemberData);
$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'}),
);
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$pool->{'ID'}));
}
}
# Sanitize params if we need to
foreach my $item (@formElements) {
$formData->{$item} = defined($formData->{$item}) ? encode_entities($formData->{$item}) : "";
}
my $pidEscaped = uri_escape($pool->{'ID'});
# Build content
my $content = "";
# Menu
my $customMenu = [
{
'name' => 'Pool Members',
'items' => [
{
'name' => 'Add Pool Member',
'link' => "poolmember-add?pid=$pidEscaped",
},
],
},
@{$menu}
];
# Form header
$content .=<<EOF;
<legend>$formType Pool Member</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">'.encode_entities($error).'</div>';
}
}
# Generate match priority list
my $matchPriorities = getMatchPriorities();
my $matchPriorityStr = "";
foreach my $matchPriorityID (sort keys %{$matchPriorities}) {
# Process selections nicely
my $selected = "";
if ($formData->{'MatchPriorityID'} ne "" && $formData->{'MatchPriorityID'} eq $matchPriorityID) {
$selected = "selected";
}
# Default to 2 if nothing specified
if ($formData->{'MatchPriorityID'} eq "" && $matchPriorityID eq "2") {
$selected = "selected";
}
# And build the options
$matchPriorityStr .= '<option value="'.$matchPriorityID.'" '.$selected.'>'.$matchPriorities->{$matchPriorityID}.
'</option>';
}
# Generate expires modifiers list
my $expiresModifierStr = "";
foreach my $expireModifier (sort keys %{$expiresModifiers}) {
# Process selections nicely
my $selected = "";
if ($formData->{'inputExpires.modifier'} ne "" && $formData->{'inputExpires.modifier'} eq $expireModifier) {
$selected = "selected";
}
# Default to n if nothing is specified
if ($formData->{'inputExpires.modifier'} eq "" && $expireModifier eq "n") {
$selected = "selected";
}
# And build the options
$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'} = "";
}
# Page content
$content .=<<EOF;
<div class="form-group">
<label for="FriendlyName" class="col-md-2 control-label">Friendly Name</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="FriendlyName" type="text" placeholder="Opt. Friendly Name" class="form-control"
value="$formData->{'FriendlyName'}" />
</div>
</div>
</div>
<div class="form-group">
<label for="Username" class="col-md-2 control-label">Username</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="Username" type="text" placeholder="Username" class="form-control"
value="$formData->{'Username'}" $formNoEdit />
<span class="input-group-addon">*</span>
</div>
</div>
</div>
<div class="form-group">
<label for="IPAddress" class="col-md-2 control-label">IP Address</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="IPAddress" type="text" placeholder="IP Address" class="form-control"
value="$formData->{'IPAddress'}" $formNoEdit />
<span class="input-group-addon">*</span>
</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">
<div class="col-md-2">
<select name="MatchPriorityID" class="form-control" $formNoEdit>
$matchPriorityStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="Expires" class="col-md-2 control-label">Expires</label>
<div class="row">
<div class="col-md-2">
<input name="Expires" type="text" placeholder="Optional" class="form-control"
value="$formData->{'Expires'}" />
</div>
<div class="col-md-2">
<select name="inputExpires.modifier" class="form-control" value="$formData->{'inputExpires.modifier'}">
$expiresModifierStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="Notes" class="col-md-2 control-label">Notes</label>
<div class="row">
<div class="col-md-4">
<textarea name="Notes" placeholder="Opt. Notes" rows="3"
class="form-control">$formData->{'Notes'}</textarea>
</div>
</div>
</div>
<div class="form-group">
<button name="submit" type="submit" value="$formType" class="btn btn-primary">$formType</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
return (HTTP_OK,$content,{ 'menu' => $customMenu });
}
# Pool member remove action
sub poolmember_remove
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Content to return
my $content = "";
# Build custom menu
my $customMenu = $menu;
# Pull in query params
my $queryParams = parseURIQuery($request);
# We need a key first of all...
if (!defined($queryParams->{'pmid'})) {
$content = <<EOF;
<div class="alert alert-danger text-center">
No pool member ID in query string!
</div>
EOF
goto END;
}
# Grab the pool
my $poolMember = getPoolMember($queryParams->{'pmid'}->{'value'});
# If we don't have a pool member it means the ID we got is invalid
if (!defined($poolMember)) {
$content = <<EOF;
<div class="alert alert-danger text-center">
Invalid pool member ID!
</div>
EOF
goto END;
}
# Make the pool ID safe for HTML
my $urlPoolMemberAdd = sprintf('/limits/poolmember-add?pid=%s',encode_entities($poolMember->{'PoolID'}));
# Menu
$customMenu = [
{
'name' => 'Pool Members',
'items' => [
{
'name' => 'Add Pool Member',
'link' => $urlPoolMemberAdd
},
],
},
@{$menu}
];
# Pull in POST
my $form = parseFormContent($request->content);
# If this is a post, then its probably a confirmation
if (defined($form->{'confirm'})) {
# Check if its a success
if ($form->{'confirm'}->{'value'} eq "Yes") {
# Post the removal
$kernel->post("configmanager" => "poolmember_remove" => $poolMember->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,sprintf('/limits/poolmember-list?pid=%s',$poolMember->{'PoolID'}));
}
# Make the friendly name HTML safe
my $poolMemberFriendlyName = (defined($poolMember->{'FriendlyName'}) && $poolMember->{'FriendlyName'} ne "") ?
$poolMember->{'FriendlyName'} : $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 "$poolMemberFriendlyNameEncoded" [$poolMemberUsernameEncoded]?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
<input type="submit" class="btn btn-default" name="confirm" value="No" />
</form>
EOF
# And here is where we return
END:
return (HTTP_OK,$content,{ 'menu' => $customMenu });
}
# Add action
sub limit_add
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Setup our environment
my $logger = $globals->{'logger'};
# Errors to display above the form
my @errors;
# Items for our form...
my @formElements = qw(
FriendlyName
Username IPAddress IPNATAddress IPNATInbound
InterfaceGroupID
MatchPriorityID
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
# Expires modifier options
my $expiresModifiers = {
'm' => "Minutes",
'h' => "Hours",
'd' => "Days",
'n' => "Never",
};
# Form data
my $formData;
# If this is a form try parse it
if ($request->method eq "POST") {
# Parse form data
my $form = parseFormContent($request->content);
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
# Transform form into form data
foreach my $key (keys %{$form}) {
$formData->{$key} = $form->{$key}->{'value'};
}
}
# We only do this if we have hash elements
if (ref($formData) eq "HASH") {
# Grab friendly name
my $friendlyName = $formData->{'FriendlyName'};
# Check POST data
my $username;
if (!defined($username = isUsername($formData->{'Username'},ISUSERNAME_ALLOW_ATSIGN))) {
push(@errors,"Username is not valid");
}
my $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");
}
my $matchPriorityID;
if (!defined($matchPriorityID = isMatchPriorityIDValid($formData->{'MatchPriorityID'}))) {
push(@errors,"Match priority is not valid");
}
my $trafficClassID;
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
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 $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'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
# Check if its defined
if (defined($formData->{'inputExpires.modifier'}) && $formData->{'inputExpires.modifier'} ne "") {
# Never
if ($formData->{'inputExpires.modifier'} eq "n") {
$expires = 0;
} elsif ($formData->{'inputExpires.modifier'} eq "m") {
$expires *= 60;
# Hours
} elsif ($formData->{'inputExpires.modifier'} eq "h") {
$expires *= 3600;
# Days
} elsif ($formData->{'inputExpires.modifier'} eq "d") {
$expires *= 86400;
} else {
push(@errors,"Expires modifier is not valid");
}
}
# Base the expiry off now, plus the expiry time
if ($expires > 0) {
$expires += time();
}
}
}
# Grab notes
my $notes = $formData->{'Notes'};
# If there are no errors we need to push this update
if (!@errors && $request->method eq "POST") {
# Build limit
my $limit = {
'FriendlyName' => $friendlyName,
'Username' => $username,
'IPAddress' => $ipAddress,
'IPNATAddress' => $ipNATAddress,
'IPNATInbound' => $ipNATInbound,
'GroupID' => 1,
'InterfaceGroupID' => $interfaceGroupID,
'MatchPriorityID' => $matchPriorityID,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
};
# Throw the change at the config manager after we add extra data we need
$limit->{'Status'} = CFGM_ONLINE;
$limit->{'Source'} = 'plugin.webserver.limits';
$kernel->post("configmanager" => "limit_add" => $limit);
$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($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'/limits');
}
}
# Sanitize params if we need to
foreach my $item (@formElements) {
$formData->{$item} = defined($formData->{$item}) ? encode_entities($formData->{$item}) : "";
}
# Build content
my $content = "";
# Form header
$content .=<<EOF;
<legend>Add Limit</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">'.encode_entities($error).'</div>';
}
}
# Generate interface group list
my @interfaceGroups = sort(getInterfaceGroups());
my $interfaceGroupStr = "";
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="'.encode_entities($interfaceGroupID).'" '.$selected.'>'.
encode_entities($interfaceGroup->{'Name'}).'</option>';
}
# Generate match priority list
my $matchPriorities = getMatchPriorities();
my $matchPriorityStr = "";
foreach my $matchPriorityID (sort keys %{$matchPriorities}) {
# Process selections nicely
my $selected = "";
if ($formData->{'MatchPriorityID'} ne "" && $formData->{'MatchPriorityID'} eq $matchPriorityID) {
$selected = "selected";
}
# Default to 2 if nothing specified
if ($formData->{'MatchPriorityID'} eq "" && $matchPriorityID eq "2") {
$selected = "selected";
}
# And build the options
$matchPriorityStr .= '<option value="'.encode_entities($matchPriorityID).'" '.$selected.'>'.
encode_entities($matchPriorities->{$matchPriorityID}).'</option>';
}
# Generate traffic class list
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $trafficClassID (@trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
# Process selections nicely
my $selected = "";
if ($formData->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.encode_entities($trafficClassID).'" '.$selected.'>'.
encode_entities($trafficClass->{'Name'}).'</option>';
}
# Generate expires modifiers list
my $expiresModifierStr = "";
foreach my $expireModifier (sort keys %{$expiresModifiers}) {
# Process selections nicely
my $selected = "";
if ($formData->{'inputExpires.modifier'} ne "" && $formData->{'inputExpires.modifier'} eq $expireModifier) {
$selected = "selected";
}
# Default to n if nothing is specified
if ($formData->{'inputExpires.modifier'} eq "" && $expireModifier eq "n") {
$selected = "selected";
}
# And build the options
$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'} = "";
}
# Page content
$content .=<<EOF;
<div class="form-group">
<label for="FriendlyName" class="col-md-2 control-label">Friendly Name</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="FriendlyName" type="text" placeholder="Opt. Friendly Name" class="form-control"
value="$formData->{'FriendlyName'}" />
</div>
</div>
</div>
<div class="form-group">
<label for="Username" class="col-md-2 control-label">Username</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="Username" type="text" placeholder="Username" class="form-control"
value="$formData->{'Username'}" />
<span class="input-group-addon">*</span>
</div>
</div>
</div>
<div class="form-group">
<label for="IPAddress" class="col-md-2 control-label">IP Address</label>
<div class="row">
<div class="col-md-4 input-group">
<input name="IPAddress" type="text" placeholder="IP Address" class="form-control"
value="$formData->{'IPAddress'}" />
<span class="input-group-addon">*</span>
</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">
<div class="col-md-2">
<select name="InterfaceGroupID" class="form-control">
$interfaceGroupStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="MatchPriorityID" class="col-md-2 control-label">Match Priority</label>
<div class="row">
<div class="col-md-2">
<select name="MatchPriorityID" class="form-control">
$matchPriorityStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-2">
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="Expires" class="col-md-2 control-label">Expires</label>
<div class="row">
<div class="col-md-2">
<input name="Expires" type="text" placeholder="Optional" class="form-control"
value="$formData->{'Expires'}" />
</div>
<div class="col-md-2">
<select name="inputExpires.modifier" class="form-control" value="$formData->{'inputExpires.modifier'}">
$expiresModifierStr
</select>
</div>
</div>
</div>
<div class="form-group">
<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="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="TxLimit" class="col-md-2 control-label">Download Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<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="RxCIR" class="col-md-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<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="RxLimit" class="col-md-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-md-3">
<div class="input-group">
<input name="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="Notes" class="col-md-2 control-label">Notes</label>
<div class="row">
<div class="col-md-4">
<textarea name="Notes" placeholder="Opt. Notes" rows="3"
class="form-control">$formData->{'Notes'}</textarea>
</div>
</div>
</div>
<div class="form-group">
<button type="submit" class="btn btn-primary">Add</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Pool override list
sub pool_override_list
{
my ($kernel,$globals,$client_session_id,$request) = @_;
my @poolOverrides = getPoolOverrides();
# Build content
my $content = "";
# Header
$content .=<<EOF;
<legend>Pool Override List</legend>
<table class="table">
<thead>
<tr>
<th></th>
<th>Friendly Name</th>
<th>Pool</th>
<th>User</th>
<th>IP</th>
<th>Expires</th>
<th></th>
<th>Class</th>
<th>CIR (Kbps)</th>
<th>Limit (Kbps)</th>
<th></th>
</tr>
</thead>
<tbody>
EOF
# Body
foreach my $poid (@poolOverrides) {
my $poolOverride;
# If we can't get the pool override, just skip it
if (!defined($poolOverride = getPoolOverride($poid))) {
next;
}
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 $poolOverrideTrafficClassStr = "-undef-";
if (defined($poolOverride->{'TrafficClassID'})) {
my $trafficClass = getTrafficClass($poolOverride->{'TrafficClassID'});
$poolOverrideTrafficClassStr = encode_entities($trafficClass->{'Name'});
}
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>$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 class="align-center">$poolOverrideTrafficClassStr</td>
<td class="align-center">$poolOverrideCIRStr</td>
<td class="align-center">$poolOverrideLimitStr</td>
<td>
<a href="$urlPoolOverrideEdit"><span class="glyphicon glyphicon-wrench" /></a>
<a href="$urlPoolOverrideRemove"><span class="glyphicon glyphicon-remove" /></a>
</td>
</tr>
EOF
}
# No results
if (!@poolOverrides) {
$content .=<<EOF;
<tr class="info">
<td colspan="11"><p class="text-center">No Results</p></td>
</tr>
EOF
}
# Footer
$content .=<<EOF;
</tbody>
</table>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Add/edit action
sub pool_override_addedit
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Setup our environment
my $logger = $globals->{'logger'};
# Errors to display above the form
my @errors;
# Items for our form...
my @formElements = qw(
FriendlyName
PoolName Username IPAddress IPNATAddress IPNATInbound
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
Expires inputExpires.modifier
Notes
);
my @formElementCheckboxes = qw(
TrafficClassID
TxCIR TxLimit
RxCIR RxLimit
);
# Expires modifier options
my $expiresModifiers = {
'm' => "Minutes",
'h' => "Hours",
'd' => "Days",
'n' => "Never",
};
# 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 pool override, this is where its kept
my $poolOverride;
# Grab query params
my $queryParams = parseURIQuery($request);
# 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");
}
}
# If this is a form try parse it
if ($request->method eq "POST") {
# Parse form data
my $form = parseFormContent($request->content);
# If user pressed cancel, redirect
if (defined($form->{'cancel'})) {
# Redirects to default page
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
# Transform form into form data
foreach my $key (keys %{$form}) {
$formData->{$key} = $form->{$key}->{'value'};
}
# Set form type if its edit
if (defined($form->{'submit'}) && $form->{'submit'}->{'value'} eq "Edit") {
# Check pool override exists
if (!defined($poolOverride)) {
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
$formData->{'ID'} = $poolOverride->{'ID'};
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
}
# A GET would indicate that a pool override ID was passed normally
} elsif ($request->method eq "GET") {
# We need a pool override
if (defined($poolOverride)) {
# Setup form data from pool override
foreach my $key (@formElements) {
$formData->{$key} = $poolOverride->{$key};
}
# Setup our checkboxes
foreach my $checkbox (@formElementCheckboxes) {
if (defined($formData->{$checkbox})) {
$formData->{"input$checkbox.enabled"} = "on";
}
}
$formType = "Edit";
$formNoEdit = "readonly";
$checkboxNoEdit = "disabled";
# Woops ... no query string?
} elsif (keys %{$queryParams} > 0) {
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
}
# We only do this if we have hash elements
if (ref($formData) eq "HASH") {
my $friendlyName = $formData->{'FriendlyName'};
if (!defined($friendlyName)) {
push(@errors,"Friendly name must be specified");
}
# 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,"At least a valid pool name, username or IP address must be specified to match");
}
# If the traffic class is ticked, process it
my $trafficClassID;
if (defined($formData->{'inputTrafficClassID.enabled'})) {
if (!defined($trafficClassID = isTrafficClassIDValid($formData->{'TrafficClassID'}))) {
push(@errors,"Traffic class is not valid");
}
}
# Check traffic limits
my $txCIR;
if (defined($formData->{'inputTxCIR.enabled'})) {
if (!defined($txCIR = isNumber($formData->{'TxCIR'}))) {
push(@errors,"Download CIR is not valid");
}
}
my $txLimit;
if (defined($formData->{'inputTxLimit.enabled'})) {
if (!defined($txLimit = isNumber($formData->{'TxLimit'}))) {
push(@errors,"Download limit is not valid");
}
}
# Check RxCIR
my $rxCIR;
if (defined($formData->{'inputRxCIR.enabled'})) {
if (!defined($rxCIR = isNumber($formData->{'RxCIR'}))) {
push(@errors,"Upload CIR is not valid");
}
}
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 pool override
if (
!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'},ISNUMBER_ALLOW_ZERO))) {
push(@errors,"Expires value is not valid");
# Check the modifier
} else {
# Check if its defined
if (defined($formData->{'inputExpires.modifier'}) && $formData->{'inputExpires.modifier'} ne "") {
# Never
if ($formData->{'inputExpires.modifier'} eq "n") {
$expires = 0;
# Minutes
} elsif ($formData->{'inputExpires.modifier'} eq "m") {
$expires *= 60;
# Hours
} elsif ($formData->{'inputExpires.modifier'} eq "h") {
$expires *= 3600;
# Days
} elsif ($formData->{'inputExpires.modifier'} eq "d") {
$expires *= 86400;
} else {
push(@errors,"Expires modifier is not valid");
}
}
# Base the expiry off now, plus the expiry time
if ($expires > 0) {
$expires += time();
}
}
}
# Grab notes
my $notes = $formData->{'Notes'};
# If there are no errors we need to push this pool override
if (!@errors && $request->method eq "POST") {
# Build pool override
my $poolOverrideData = {
'FriendlyName' => $friendlyName,
'PoolName' => $poolName,
'Username' => $username,
'IPAddress' => $ipAddress,
# 'IPNATAddress' => $ipNATAddress,
# 'GroupID' => 1,
'TrafficClassID' => $trafficClassID,
'TxCIR' => $txCIR,
'TxLimit' => $txLimit,
'RxCIR' => $rxCIR,
'RxLimit' => $rxLimit,
'Expires' => $expires,
'Notes' => $notes,
};
# Check if this is an add or edit
my $cEvent;
if ($formType eq "Add") {
$cEvent = "pool_override_add";
} else {
$poolOverrideData->{'ID'} = $formData->{'ID'};
$cEvent = "pool_override_change";
}
$kernel->post("configmanager" => $cEvent => $poolOverrideData);
$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($trafficClassID),
prettyUndef($txCIR),
prettyUndef($rxCIR),
prettyUndef($txLimit),
prettyUndef($rxLimit)
);
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
}
# Handle checkboxes first and a little differently
foreach my $item (@formElementCheckboxes) {
$formData->{"input$item.enabled"} = defined($formData->{"input$item.enabled"}) ? "checked" : "";
}
# Sanitize params if we need to
foreach my $item (@formElements) {
$formData->{$item} = defined($formData->{$item}) ? encode_entities($formData->{$item}) : "";
}
# Build content
my $content = "";
# Form header
$content .=<<EOF;
<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">'.encode_entities($error).'</div>';
}
}
# Generate traffic class list
my @trafficClasses = sort(getTrafficClasses());
my $trafficClassStr = "";
foreach my $trafficClassID (@trafficClasses) {
my $trafficClass = getTrafficClass($trafficClassID);
# Process selections nicely
my $selected = "";
if ($formData->{'TrafficClassID'} ne "" && $formData->{'TrafficClassID'} eq $trafficClassID) {
$selected = "selected";
}
# And build the options
$trafficClassStr .= '<option value="'.$trafficClassID.'" '.$selected.'>'.encode_entities($trafficClass->{'Name'}).
'</option>';
}
# Generate expires modifiers list
my $expiresModifierStr = "";
foreach my $expireModifier (sort keys %{$expiresModifiers}) {
# Process selections nicely
my $selected = "";
if ($formData->{'inputExpires.modifier'} ne "" && $formData->{'inputExpires.modifier'} eq $expireModifier) {
$selected = "selected";
}
# Default to n if nothing is specified
if ($formData->{'inputExpires.modifier'} eq "" && $expireModifier eq "n") {
$selected = "selected";
}
# And build the options
$expiresModifierStr .= '<option value="'.$expireModifier.'" '.$selected.'>'.
encode_entities($expiresModifiers->{$expireModifier}).'</option>';
}
# Blank expires if its 0
if (defined($formData->{'Expires'}) && $formData->{'Expires'} eq "0") {
$formData->{'Expires'} = "";
}
#
# Page content
#
$content .=<<EOF;
<div class="form-group">
<label for="FriendlyName" class="col-md-2 control-label">FriendlyName</label>
<div class="row">
<div class="col-md-4">
<div class="input-group">
<input name="FriendlyName" type="text" placeholder="Friendly Name" class="form-control"
value="$formData->{'FriendlyName'}" />
<span class="input-group-addon">*</span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="PoolName" class="col-md-2 control-label">Pool Name</label>
<div class="row">
<div class="col-md-4">
<input name="PoolName" type="text" placeholder="Pool Name To Override" class="form-control"
value="$formData->{'PoolName'}" $formNoEdit/>
</div>
</div>
</div>
<div class="form-group">
<label for="Username" class="col-md-2 control-label">Username</label>
<div class="row">
<div class="col-md-4">
<input name="Username" type="text" placeholder="Username To Override" class="form-control"
value="$formData->{'Username'}" $formNoEdit/>
</div>
</div>
</div>
<div class="form-group">
<label for="IPAddress" class="col-md-2 control-label">IP Address</label>
<div class="row">
<div class="col-md-4">
<input name="IPAddress" type="text" placeholder="And/Or IP Address To Override" class="form-control"
value="$formData->{'IPAddress'}" $formNoEdit/>
</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="TrafficClassID" class="col-md-2 control-label">Traffic Class</label>
<div class="row">
<div class="col-md-3">
<input name="inputTrafficClassID.enabled" type="checkbox" $formData->{'inputTrafficClassID.enabled'}/>
Override
<select name="TrafficClassID" class="form-control">
$trafficClassStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="TxCIR" class="col-md-2 control-label">Download CIR</label>
<div class="row">
<div class="col-md-3">
<input name="inputTxCIR.enabled" type="checkbox" $formData->{'inputTxCIR.enabled'} />
Override
<div class="input-group">
<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="TxLimit" class="col-md-2 control-label">Download Limit</label>
<div class="row">
<div class="col-md-3">
<input name="inputTxLimit.enabled" type="checkbox"
$formData->{'inputTxLimit.enabled'}/> Override
<div class="input-group">
<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="inputRxCIR" class="col-md-2 control-label">Upload CIR</label>
<div class="row">
<div class="col-md-3">
<input name="inputRxCIR.enabled" type="checkbox"
$formData->{'inputRxCIR.enabled'}/> Override
<div class="input-group">
<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="RxLimit" class="col-md-2 control-label">Upload Limit</label>
<div class="row">
<div class="col-md-3">
<input name="inputRxLimit.enabled" type="checkbox"
$formData->{'inputRxLimit.enabled'}/> Override
<div class="input-group">
<input name="RxLimit" type="text" placeholder="Upload Limit" class="form-control"
value="$formData->{'RxLimit'}" />
<span class="input-group-addon">Kbps<span>
</div>
</div>
</div>
</div>
<div class="form-group">
<label for="Expires" class="col-md-2 control-label">Expires</label>
<div class="row">
<div class="col-md-2">
<input name="Expires" type="text" placeholder="Expires" class="form-control"
value="$formData->{'Expires'}" />
</div>
<div class="col-md-2">
<select name="inputExpires.modifier" class="form-control" value="$formData->{'inputExpires.modifier'}">
$expiresModifierStr
</select>
</div>
</div>
</div>
<div class="form-group">
<label for="Notes" class="col-md-2 control-label">Notes</label>
<div class="row">
<div class="col-md-4">
<textarea name="Notes" placeholder="Notes" rows="3" class="form-control">$formData->{'Notes'}</textarea>
</div>
</div>
</div>
<div class="form-group">
<button name="submit" type="submit" value="$formType" class="btn btn-primary">$formType</button>
<button name="cancel" type="submit" class="btn">Cancel</button>
</div>
</form>
EOF
return (HTTP_OK,$content,{ 'menu' => $menu });
}
# Remove action
sub pool_override_remove
{
my ($kernel,$globals,$client_session_id,$request) = @_;
# Content to return
my $content = "";
# Pull in GET
my $queryParams = parseURIQuery($request);
# We need a key first of all...
if (!defined($queryParams->{'poid'})) {
$content = <<EOF;
<div class="alert alert-danger text-center">
No pool override oid in query string!
</div>
EOF
goto END;
}
# Grab the pool override
my $poolOverride = getPoolOverride($queryParams->{'poid'}->{'value'});
# Make the oid safe for HTML
my $encodedPoolOverrideID = encode_entities($queryParams->{'poid'}->{'value'});
# 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 pool override oid "$encodedPoolOverrideID"!
</div>
EOF
goto END;
}
# Pull in POST
my $form = parseFormContent($request->content);
# If this is a post, then its probably a confirmation
if (defined($form->{'confirm'})) {
# Check if its a success
if ($form->{'confirm'}->{'value'} eq "Yes") {
# Post the removal
$kernel->post("configmanager" => "pool_override_remove" => $poolOverride->{'ID'});
}
return (HTTP_TEMPORARY_REDIRECT,'/limits/pool-override-list');
}
# Make the friendly name HTML safe
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 pool override "$encodedPoolOverrideFriendlyName"?
</div>
<form role="form" method="post">
<input type="submit" class="btn btn-primary" name="confirm" value="Yes" />
<input type="submit" class="btn btn-default" name="confirm" value="No" />
</form>
EOF
# And here is where we return
END:
return (HTTP_OK,$content,{ 'menu' => $menu });
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/static.pm
View file @ efc9ebe1
# OpenTrafficShaper webserver module: index 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
# the Free Software Foundation, either version 3 of the License, or
......@@ -41,6 +41,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
);
sub _catchall
{
my ($kernel,$globals,$client_session_id,$request) = @_;
......@@ -48,7 +49,7 @@ sub _catchall
# Else get our resource name
(my $resource = $request->uri) =~ s/[^A-Za-z0-9\-\/\.]//g;
(my $resource = $request->uri) =~ s/[^A-Za-z0-9\-\/\.]//g;
# Just abort if the request contains a transversal
return if ($resource =~ /\.\./);
# Again if its odd, abort
......@@ -60,7 +61,7 @@ sub _catchall
# Join it back up
$resource = join('/',@pathComponents);
$logger->log(LOG_DEBUG,"[WEBSEVER/STATIC] Access request for resource '$resource'");
$logger->log(LOG_DEBUG,"[WEBSEVER/STATIC] Access request for resource '%s'",$resource);
# Check if this is a supported method
return if ($request->method ne "GET");
......@@ -71,20 +72,20 @@ sub _catchall
# Check it exists...
if (! -f $filename) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Resource '$resource' does not exist or is not a normal file");
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Resource '%s' does not exist or is not a normal file",$resource);
return;
}
# Stat file first of all
my $stat = stat($filename);
my $stat = stat($filename);
if (!$stat) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to stat '$resource': $!");
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to stat '%s': %s",$resource,$!);
return;
}
# Check this is a file
if (!S_ISREG($stat->mode)) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Not a file '$resource'");
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Not a file '%s'",$resource);
return;
}
......@@ -107,8 +108,8 @@ sub _catchall
$response->header('Last-Modified', HTTP::Date::time2str($stat->mtime));
# Open file handle
if (!open(FH, "< $filename")) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to open '$resource': $!");
if (!open(FH, "< $filename")) {
$logger->log(LOG_WARN,"[WEBSERVER/STATIC] Unable to open '%s': %s",$resource,$!);
}
# Set to binary mode
binmode(FH);
......@@ -124,8 +125,10 @@ sub _catchall
# Set content
$response->content($buffer);
return $response;
return $response;
}
1;
# vim: ts=4
opentrafficshaper/plugins/webserver/pages/static/awit-flot-toolkit/AUTHORS 0 → 100644
View file @ efc9ebe1
Project Leader
--------------
Nigel Kukard <nkukard@lbsd.net>
Charl Mert <cmert@lbsd.net>