summaryrefslogtreecommitdiff
path: root/lib/Vyatta/Qos/TrafficShaper.pm
diff options
context:
space:
mode:
authorStephen Hemminger <stephen.hemminger@vyatta.com>2009-02-05 14:35:02 -0800
committerStephen Hemminger <stephen.hemminger@vyatta.com>2009-02-05 14:35:02 -0800
commitde0162fc82d3939fae0dc42bbb1e4630cb99e1ca (patch)
tree78f725ef7a3a791a27ea3c076fd231ef7ab44646 /lib/Vyatta/Qos/TrafficShaper.pm
parent20cc5a71f3c8cfed4640cb8565fb715be0a15ee8 (diff)
downloadvyatta-cfg-qos-de0162fc82d3939fae0dc42bbb1e4630cb99e1ca.tar.gz
vyatta-cfg-qos-de0162fc82d3939fae0dc42bbb1e4630cb99e1ca.zip
Split shaperclass into separate file
Diffstat (limited to 'lib/Vyatta/Qos/TrafficShaper.pm')
-rw-r--r--lib/Vyatta/Qos/TrafficShaper.pm217
1 files changed, 2 insertions, 215 deletions
diff --git a/lib/Vyatta/Qos/TrafficShaper.pm b/lib/Vyatta/Qos/TrafficShaper.pm
index ca0baa7..0cfb305 100644
--- a/lib/Vyatta/Qos/TrafficShaper.pm
+++ b/lib/Vyatta/Qos/TrafficShaper.pm
@@ -18,225 +18,12 @@
# All Rights Reserved.
# **** End License ****
-{
- package ShaperClass;
- use strict;
- require Vyatta::Config;
- use Vyatta::Qos::Match;
- use Vyatta::Qos::Util qw/getDsfield getRate/;
-
- my %fields = (
- id => undef,
- dsmark => undef,
- _priority => undef,
- _rate => undef,
- _ceiling => undef,
- _burst => undef,
- _match => undef,
- _limit => undef,
- _qdisc => undef,
- );
-
- sub new {
- my ( $that, $config, $id ) = @_;
- my $class = ref($that) || $that;
- my $self = {%fields};
-
- $self->{id} = $id;
-
- bless $self, $class;
- $self->_define($config);
-
- return $self;
- }
-
- sub _define {
- my ( $self, $config ) = @_;
- my $level = $config->setLevel();
- my @matches = ();
-
- $self->{_rate} = $config->returnValue("bandwidth");
- defined $self->{_rate} or die "$level bandwidth not defined\n";
-
- $self->{_priority} = $config->returnValue("priority");
- $self->{_ceiling} = $config->returnValue("ceiling");
- $self->{_burst} = $config->returnValue("burst");
- $self->{_limit} = $config->returnValue("queue-limit");
- $self->{_qdisc} = $config->returnValue("queue-type");
-
- $self->{dsmark} = getDsfield($config->returnValue("set-dscp"));
-
- foreach my $match ($config->listNodes("match")) {
- $config->setLevel("$level match $match");
- push @matches, new Vyatta::Qos::Match($config);
- }
- $self->{_match} = \@matches;
- }
-
- sub matchRules {
- my ($self) = @_;
- my $matches = $self->{_match};
- return @$matches;
- }
-
- sub _getPercentRate {
- my ($rate, $speed) = @_;
-
- if ( ! defined $rate ) {
- return; # leave rate undef
- }
-
- # Rate might be a percentage of speed
- if ( $rate =~ /%$/ ) {
- my $percent = substr( $rate, 0, length($rate) - 1 );
- if ( $percent < 0 || $percent > 100 ) {
- die "Invalid percentage bandwidth: $percent\n";
- }
-
- $rate = ( $percent * $speed ) / 100.;
- } else {
- $rate = getRate($rate);
- }
-
- return $rate;
- }
-
- sub rateCheck {
- my ($self, $limit, $level) = @_;
-
- my $rate = _getPercentRate($self->{_rate}, $limit);
- if ($rate > $limit) {
- print STDERR "Configuration error in: $level\n";
- printf STDERR
- "The bandwidth reserved for this class (%dKbps) must be less than\n",
- $rate / 1000;
- printf STDERR "the bandwidth for the overall policy (%dKbps)\n",
- $limit / 1000;
- exit 1;
- }
-
- my $ceil = _getPercentRate($self->{_ceiling}, $limit);
- if (defined $ceil && $ceil < $rate) {
- print STDERR "Configuration error in: $level\n";
- printf STDERR
- "The bandwidth ceiling for this class (%dKbps) must be greater or equal to\n",
- $ceil / 1000;
- printf STDERR "the reserved bandwidth for the class (%dKbps)\n",
- $rate / 1000;
- exit 1;
- }
- }
-
- sub prioQdisc {
- my ($self, $out, $dev, $rate) = @_;
- my $prio_id = 0x4000 + $self->{id};
- my $limit = $self->{_limit};
-
- printf {$out} "handle %x: prio\n", $prio_id;
-
- if ($limit) {
- foreach my $i (qw/1 2 3/) {
- printf {$out} "qdisc add dev %s parent %x:%d pfifo limit %d\n",
- $dev, $prio_id, $i, $limit;
- }
- }
- }
-
- sub sfqQdisc {
- my ($self, $out, $dev, $rate ) = @_;
-
- print ${out} "sfq";
- print ${out} " limit $self->{_limit}" if ($self->{_limit});
- print ${out} "\n";
- }
-
- sub fifoQdisc {
- my ($self, $out, $dev, $rate) = @_;
-
- print ${out} "pfifo";
- print ${out} " limit $self->{_limit}" if ($self->{_limit});
- print ${out} "\n";
- }
-
- # Red is has way to many configuration options
- # make some assumptions to make this sane (based on LARTC)
- # average size := 1000 bytes
- # limit := queue-limit * average
- # max := limit / 8
- # min := max / 3
- # burst := (2 * min + max) / (3 * average)
- sub redQdisc {
- my ($self, $out, $dev, $rate) = @_;
- my $limit = $self->{_limit};
- my $avg = 1000;
- my $qlimit;
-
- if (defined $limit) {
- $qlimit = $limit * $avg; # red limit in bytes
- } else {
- # rate is in bits/sec so queue-limit = 8 * 500ms * rate
- $qlimit = $rate / 2;
- }
- my $qmax = $qlimit / 8;
- my $qmin = $qmax / 3;
-
- printf ${out} "red limit %d min %d max %d avpkt %d",
- $qlimit, $qmin, $qmax, $avg;
- printf ${out} " burst %d probability 0.02 bandwidth %d ecn\n",
- (2 * $qmin + $qmax) / (3 * $avg), $rate / 1000;
- }
-
- my %qdiscOptions = (
- 'priority' => \&prioQdisc,
- 'fair-queue' => \&sfqQdisc,
- 'random-detect' => \&redQdisc,
- 'drop-tail' => \&fifoQdisc,
- );
-
- sub htbClass {
- my ( $self, $out, $dev, $parent, $speed ) = @_;
- my $rate = _getPercentRate($self->{_rate}, $speed);
- my $ceil = _getPercentRate($self->{_ceiling}, $speed);
-
- printf ${out} "class add dev %s parent %x:1 classid %x:%x htb rate %s",
- $dev, $parent, $parent, $self->{id}, $rate;
-
- print ${out} " ceil $ceil" if ( $ceil );
- print ${out} " burst $self->{_burst}" if ( defined $self->{_burst} );
- print ${out} " prio $self->{_priority}" if ( defined $self->{_priority} );
- print {$out} "\n";
-
- # create leaf qdisc
- my $q = $qdiscOptions{$self->{_qdisc}};
- if (defined $q) {
- printf {$out} "qdisc add dev %s parent %x:%x ",
- $dev, $parent, $self->{id};
- $q->($self, $out, $dev, $rate);
- } else {
- die "Unknown queue type $self->{_qdisc}\n";
- }
- }
-
- sub dsmarkClass {
- my ( $self, $out, $parent, $dev ) = @_;
-
- printf ${out} "class change dev %s classid %x:%x dsmark",
- $dev, $parent, $self->{id};
-
- if ($self->{dsmark}) {
- print ${out} " mask 0 value $self->{dsmark}\n";
- } else {
- print ${out} " mask 0xff value 0\n";
- }
- }
-
-}
-
package Vyatta::Qos::TrafficShaper;
use strict;
require Vyatta::Config;
use Vyatta::Qos::Util qw/getRate interfaceRate/;
+use Vyatta::Qos::ShaperClass;
my %fields = (
@@ -457,7 +244,7 @@ sub isChanged {
}
}
- return undef; # false
+ return; # false
}
1;