diff options
author | Stephen Hemminger <stephen.hemminger@vyatta.com> | 2008-11-20 12:16:02 -0800 |
---|---|---|
committer | Stephen Hemminger <stephen.hemminger@vyatta.com> | 2008-11-20 20:34:16 -0800 |
commit | 790663c88fb291ddb5b645bdde62d8229d5e115b (patch) | |
tree | bdf236cc76437e82df9254d3cb89ef1c271424bc /scripts | |
parent | 22fba825c57ed336bca64ff154bbd911bc6754d5 (diff) | |
download | vyatta-cfg-qos-790663c88fb291ddb5b645bdde62d8229d5e115b.tar.gz vyatta-cfg-qos-790663c88fb291ddb5b645bdde62d8229d5e115b.zip |
Change perl module names from VyattaQosXXX to Vyatta::Qos:XXX
Use more multi-level directory hierarchy instead of having all
modules at top level.
Diffstat (limited to 'scripts')
-rw-r--r-- | scripts/VyattaQosDropTail.pm | 57 | ||||
-rw-r--r-- | scripts/VyattaQosFairQueue.pm | 66 | ||||
-rw-r--r-- | scripts/VyattaQosMatch.pm | 100 | ||||
-rw-r--r-- | scripts/VyattaQosRateLimiter.pm | 71 | ||||
-rw-r--r-- | scripts/VyattaQosTrafficLimiter.pm | 195 | ||||
-rw-r--r-- | scripts/VyattaQosTrafficShaper.pm | 461 | ||||
-rw-r--r-- | scripts/VyattaQosUtil.pm | 293 | ||||
-rwxr-xr-x | scripts/vyatta-qos-util.pl | 85 | ||||
-rwxr-xr-x | scripts/vyatta-qos.pl | 28 |
9 files changed, 48 insertions, 1308 deletions
diff --git a/scripts/VyattaQosDropTail.pm b/scripts/VyattaQosDropTail.pm deleted file mode 100644 index 1345fb0..0000000 --- a/scripts/VyattaQosDropTail.pm +++ /dev/null @@ -1,57 +0,0 @@ -# This is a wrapper around FIFO queue discipline -# -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaQosDropTail; - -use strict; -require VyattaConfig; -use VyattaQosUtil; - -my %fields = ( - _limit => undef, -); - -sub new { - my ( $that, $config ) = @_; - my $level = $config->setLevel(); - my $class = ref($that) || $that; - my $self = {%fields}; - - $self->{_limit} = $config->returnValue("queue-limit"); - - return bless $self, $class; -} - -sub commands { - my ( $self, $out, $dev ) = @_; - my $limit = $self->{_limit}; - my $cmd = "qdisc add dev $dev root pfifo"; - - $cmd .= " limit $limit" if defined $limit; - printf {$out} "%s\n", $cmd; -} - -sub isChanged { - my ($self, $name) = @_; - my $config = new VyattaConfig; - - $config->setLevel("qos-policy drop-tail $name"); - return $config->isChanged('queue-limit'); -} - -1; diff --git a/scripts/VyattaQosFairQueue.pm b/scripts/VyattaQosFairQueue.pm deleted file mode 100644 index 278bb77..0000000 --- a/scripts/VyattaQosFairQueue.pm +++ /dev/null @@ -1,66 +0,0 @@ -# This is a wrapper around Stochastic Fair Queue(SFQ) queue discipline -# Since SFQ is a hard to explain, use the name fair-queue since SFQ -# is most similar to Weighted Fair Queue (WFQ) on Cisco IOS. -# -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaQosFairQueue; - -use strict; - -require VyattaConfig; - -# Fair Queue -# Uses SFQ which is similar to (but not same as) WFQ - -my %fields = ( - _perturb => undef, - _limit => undef, -); - -sub new { - my ( $that, $config ) = @_; - my $class = ref($that) || $that; - my $self = {%fields}; - - $self->{_perturb} = $config->returnValue('hash-interval'); - $self->{_limit} = $config->returnValue('queue-limit'); - return bless $self, $class; -} - -sub commands { - my ( $self, $out, $dev ) = @_; - - print {$out} "qdisc add dev $dev root sfq"; - print {$out} " perturb $self->{_perturb}" if ( defined $self->{_perturb} ); - print {$out} " limit $self->{_limit}" if ( defined $self->{_limit} ); - print "\n"; -} - -sub isChanged { - my ( $self, $name ) = @_; - my $config = new VyattaConfig; - - $config->setLevel("qos-policy fair-queue $name"); - foreach my $attr ('hash-interval', 'queue-limit') { - if ($config->isChanged($attr)) { - return $attr - } - } - return undef; # false -} -1; diff --git a/scripts/VyattaQosMatch.pm b/scripts/VyattaQosMatch.pm deleted file mode 100644 index 9c9945d..0000000 --- a/scripts/VyattaQosMatch.pm +++ /dev/null @@ -1,100 +0,0 @@ -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaQosMatch; -require VyattaConfig; -use VyattaQosUtil; -use strict; - -my %fields = ( - _dev => undef, - _vif => undef, - _ip => undef, -); - -sub new { - my ( $that, $config ) = @_; - my $self = {%fields}; - my $class = ref($that) || $that; - - bless $self, $class; - $self->_define($config); - - return $self; -} - -sub _define { - my ( $self, $config ) = @_; - my $level = $config->setLevel(); - - $self->{_vif} = $config->returnValue("vif"); - $self->{_dev} = VyattaQosUtil::getIfIndex($config->returnValue("interface")); - - if ($config->exists("ip")) { - my %ip; - - $ip{dsfield} = VyattaQosUtil::getDsfield( $config->returnValue("ip dscp")); - $ip{protocol} = VyattaQosUtil::getProtocol($config->returnValue("ip protocol")); - $ip{src} = $config->returnValue("ip source address"); - $ip{dst} = $config->returnValue("ip destination address"); - $ip{sport} = $config->returnValue("ip source port"); - $ip{dport} = $config->returnValue("ip destination port"); - $self->{_ip} = \%ip; - } -} - -sub filter { - my ( $self, $out, $dev, $parent, $prio, $dsmark ) = @_; - my $ip = $self->{_ip}; - my $indev = $self->{_dev}; - my $vif = $self->{_vif}; - - # Catch empty match - if (! (defined $ip || defined $indev || defined $vif)) { - return; - } - - # Special case for when dsmarking is used with ds matching - # original dscp is saved in tc_index - if (defined $dsmark && defined $ip && defined $$ip{dsfield}) { - printf {$out} "filter add dev %s parent %x: protocol ip prio 1", - $dev, $parent; - printf ${out} " handle %d tcindex", $$ip{dsfield}; - return; - } - - printf {$out} "filter add dev %s parent %x: prio %d", $dev, $parent, $prio; - if (defined $ip) { - print {$out} " protocol ip u32"; - print {$out} " match ip dsfield $$ip{dsfield} 0xff" - if defined $$ip{dsfield}; - print {$out} " match ip protocol $$ip{protocol} 0xff" - if defined $$ip{protocol}; - print {$out} " match ip src $$ip{src}" - if defined $$ip{src}; - print {$out} " match ip sport $$ip{sport} 0xffff" - if defined $$ip{sport}; - print {$out} " match ip dst $$ip{dst}" - if defined $$ip{dst}; - print {$out} " match ip dport $$ip{dport} 0xffff" - if defined $$ip{dport}; - } else { - print {$out} " protocol all basic"; - print {$out} " match meta\(rt_iif eq $indev\)" - if (defined $indev); - print {$out} " match meta\(vlan mask 0xfff eq $vif\)" - if (defined $vif); - } -} diff --git a/scripts/VyattaQosRateLimiter.pm b/scripts/VyattaQosRateLimiter.pm deleted file mode 100644 index f519683..0000000 --- a/scripts/VyattaQosRateLimiter.pm +++ /dev/null @@ -1,71 +0,0 @@ -# This is a wrapper around Token Bucket Filter (TBF) queue discipline -# -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaQosRateLimiter; - -use strict; - -require VyattaConfig; -use VyattaQosUtil; - -my %fields = ( - _rate => undef, - _burst => undef, - _latency => undef, -); - -sub new { - my ( $that, $config ) = @_; - my $level = $config->setLevel(); - my $class = ref($that) || $that; - my $self = {%fields}; - - $self->{_rate} = VyattaQosUtil::getRate($config->returnValue("bandwidth")); - defined $self->{_rate} or die "$level bandwidth not defined\n"; - - $self->{_burst} = $config->returnValue("burst"); - defined $self->{_burst} or die "$level burst not defined\n"; - - $self->{_latency} = VyattaQosUtil::getTime($config->returnValue("latency")); - defined $self->{_latency} or die "$level latency not defined\n"; - - return bless $self, $class; -} - -sub commands { - my ( $self, $out, $dev ) = @_; - - - printf {$out} "qdisc add dev %s root tbf rate %s latency %s burst %s\n", - $dev, $self->{_rate}, $self->{_latency}, $self->{_burst}; -} - -sub isChanged { - my ($self, $name) = @_; - my $config = new VyattaConfig; - - $config->setLevel("qos-policy rate-limit $name"); - foreach my $attr ('bandwidth', 'burst', 'latency') { - if ($config->isChanged($attr)) { - return $attr - } - } - return undef; # false -} - -1; diff --git a/scripts/VyattaQosTrafficLimiter.pm b/scripts/VyattaQosTrafficLimiter.pm deleted file mode 100644 index 2907590..0000000 --- a/scripts/VyattaQosTrafficLimiter.pm +++ /dev/null @@ -1,195 +0,0 @@ -# Traffic limiter -# This is a rate limiter based on ingress qdisc -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -{ - - package LimiterClass; - use strict; - require VyattaConfig; - use VyattaQosMatch; - - my %fields = ( - id => undef, - priority => undef, - rate => undef, - _match => 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 = (); - my $rate = $config->returnValue("bandwidth"); - - defined $rate or die "bandwidth must be defined for $level\n"; - $self->{rate} = VyattaQosUtil::getRate($rate); - - $self->{priority} = $config->returnValue("priority"); - - foreach my $match ( $config->listNodes("match") ) { - $config->setLevel("$level match $match"); - push @matches, new VyattaQosMatch($config); - } - $self->{_match} = \@matches; - } - - sub matchRules { - my ($self) = @_; - my $matches = $self->{_match}; - return @$matches; - } - -} - -package VyattaQosTrafficLimiter; -use strict; -require VyattaConfig; -use VyattaQosUtil; - -my %fields = ( - _level => undef, - _classes => undef, -); - -# new VyattaQosTrafficLimiter($config) -# Create a new instance based on config information -sub new { - my ( $that, $config, $name ) = @_; - my $self = {%fields}; - my $class = ref($that) || $that; - - bless $self, $class; - $self->_define($config); - - return $self; -} - -# Setup new instance. -# Assumes caller has done $config->setLevel to "traffic-limiter $name" -sub _define { - my ( $self, $config ) = @_; - my $level = $config->setLevel(); - my @classes = (); - - $self->{_level} = $level; - - # make sure no clash of different types of tc filters - my %matchTypes = (); - foreach my $class ( $config->listNodes("class") ) { - foreach my $match ( $config->listNodes("class $class match") ) { - foreach my $type ( $config->listNodes("class $class match $match") ) - { - $matchTypes{$type} = "$class match $match"; - } - } - } - - if ( scalar keys %matchTypes > 1 && $matchTypes{ip} ) { - print "Match type conflict:\n"; - while ( my ( $type, $usage ) = each(%matchTypes) ) { - print " class $usage $type\n"; - } - die "$level can not match on both ip and other types\n"; - } - - foreach my $id ( $config->listNodes("class") ) { - $config->setLevel("$level class $id"); - push @classes, new LimiterClass( $config, $id ); - } - $self->{_classes} = \@classes; -} - -sub commands { - my ( $self, $out, $dev ) = @_; - my $classes = $self->{_classes}; - my $parent = 0xffff; - - printf {$out} "qdisc add dev %s handle %x: ingress\n", $dev, $parent; - foreach my $class (@$classes) { - my $id = $class->{id}; - my $rate = $class->{rate}; - my $priority = $class->{priority}; - - foreach my $match ( $class->matchRules() ) { - $match->filter( $out, $dev, $parent, $priority ); - printf {$out} " police avrate %s drop flowid :%x\n", $rate, $id; - } - } -} - -# Walk configuration tree and look for changed nodes -# The configuration system should do this but doesn't do it right -sub isChanged { - my ( $self, $name ) = @_; - my $config = new VyattaConfig; - - $config->setLevel("qos-policy traffic-limiter $name"); - my %classNodes = $config->listNodeStatus('class'); - while ( my ( $class, $status ) = each %classNodes ) { - if ( $status ne 'static' ) { - return "class $class"; - } - - foreach my $attr ( 'bandwidth', 'burst', 'priority' ) { - if ( $config->isChanged("class $class $attr") ) { - return "class $class $attr"; - } - } - - my %matchNodes = $config->listNodeStatus("class $class match"); - while ( my ( $match, $status ) = each %matchNodes ) { - my $level = "class $class match $match"; - if ( $status ne 'static' ) { - return $level; - } - - foreach my $parm ( - 'vif', - 'interface', - 'ip dscp', - 'ip protocol', - 'ip source address', - 'ip destination address', - 'ip source port', - 'ip destination port' - ) - { - if ( $config->isChanged("$level $parm") ) { - return "$level $parm"; - } - } - } - } - - return undef; # false -} - -1; diff --git a/scripts/VyattaQosTrafficShaper.pm b/scripts/VyattaQosTrafficShaper.pm deleted file mode 100644 index 5f9fe75..0000000 --- a/scripts/VyattaQosTrafficShaper.pm +++ /dev/null @@ -1,461 +0,0 @@ -# Traffic shaper -# This is a extended form of Hierarchal Token Bucket with -# more admin friendly features. Similar in spirt to other shaper scripts -# such as wondershaper. -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -{ - package ShaperClass; - use strict; - require VyattaConfig; - use VyattaQosMatch; - - 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} = - VyattaQosUtil::getDsfield($config->returnValue("set-dscp")); - - foreach my $match ($config->listNodes("match")) { - $config->setLevel("$level match $match"); - push @matches, new VyattaQosMatch($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 = VyattaQosUtil::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 VyattaQosTrafficShaper; -use strict; -require VyattaConfig; -use VyattaQosUtil; - -my %fields = ( - _level => undef, - _rate => undef, - _classes => undef, -); - -# new VyattaQosTrafficShaper($config) -# Create a new instance based on config information -sub new { - my ( $that, $config, $name ) = @_; - my $self = {%fields}; - my $class = ref($that) || $that; - - bless $self, $class; - $self->_define($config); - - $self->_validate($config); - - return $self; -} - -sub _validate { - my $self = shift; - - if ( $self->{_rate} ne "auto" ) { - my $classes = $self->{_classes}; - my $default = shift @$classes; - my $rate = VyattaQosUtil::getRate($self->{_rate}); - - $default->rateCheck($rate, "$self->{_level} default"); - - foreach my $class (@$classes) { - $class->rateCheck($rate, "$self->{_level} class $class->{id}"); - } - unshift @$classes, $default - } -} - -# Rate can be something like "auto" or "10.2mbit" -sub _getAutoRate { - my ($rate, $dev) = @_; - - if ( $rate eq "auto" ) { - $rate = VyattaQosUtil::interfaceRate($dev); - if (! defined $rate ) { - print STDERR "Interface $dev speed cannot be determined (assuming 10mbit)\n"; - $rate = 10000000; - } - } else { - $rate = VyattaQosUtil::getRate($rate); - } - - return $rate; -} - -# Setup new instance. -# Assumes caller has done $config->setLevel to "traffic-shaper $name" -sub _define { - my ( $self, $config ) = @_; - my $level = $config->setLevel(); - my @classes = ( ); - - $self->{_rate} = $config->returnValue("bandwidth"); - $self->{_level} = $level; - - $config->exists("default") - or die "$level configuration not complete: missing default class\n"; - - # make sure no clash of different types of tc filters - my %matchTypes = (); - foreach my $class ( $config->listNodes("class")) { - foreach my $match ( $config->listNodes("class $class match") ) { - foreach my $type ( $config->listNodes("class $class match $match") ) { - $matchTypes{$type} = "$class match $match"; - } - } - } - - if (scalar keys %matchTypes > 1 && $matchTypes{ip}) { - print "Match type conflict:\n"; - while (my ($type, $usage) = each(%matchTypes)) { - print " class $usage $type\n"; - } - die "$level can not match on both ip and other types\n"; - } - - - $config->setLevel("$level default"); - push @classes, new ShaperClass($config, -1); - $config->setLevel($level); - - foreach my $id ( $config->listNodes("class") ) { - $config->setLevel("$level class $id"); - push @classes, new ShaperClass( $config, $id ); - } - $self->{_classes} = \@classes; -} - -sub commands { - my ( $self, $out, $dev ) = @_; - my $rate = _getAutoRate($self->{_rate}, $dev); - my $classes = $self->{_classes}; - my %dsmark = (); - my $default = shift @$classes; - my $maxid = 1; - - $default->rateCheck($rate, "$self->{_level} default"); - - foreach my $class (@$classes) { - $class->rateCheck($rate, "$self->{_level} class $class->{id}"); - - # find largest class id - if (defined $class->{id} && $class->{id} > $maxid) { - $maxid = $class->{id}; - } - } - - # fill in id of default - $default->{id} = ++$maxid; - unshift @$classes, $default; - - # Check if we need dsmrk - my $usedsmark; - foreach my $class (@$classes) { - if (defined $class->{dsmark}) { - $usedsmark = 1; - last; - } - } - - my $parent = 1; - my $root = "root"; - - # if we need to change dsfield values, then put dsmark in front - if ($usedsmark) { - # dsmark max index must be power of 2 - my $indices = $maxid + 1; - while (($indices & ($indices - 1)) != 0) { - ++$indices; - } - - print {$out} "qdisc add dev $dev handle 1:0 root dsmark" - . " indices $indices default_index $default->{id} set_tc_index\n"; - - foreach my $class (@$classes) { - $class->dsmarkClass($out, 1, $dev); - foreach my $match ($class->matchRules()) { - $match->filter($out, $dev, 1, 1); - printf {$out} " classid %x:%x\n", $parent, $class->{id}; - } - } - - $parent = $indices + 1; - $root = "parent 1:1" - } - - printf {$out} "qdisc add dev %s %s handle %x: htb default %x\n", - $dev, $root, $parent, $default->{id}; - printf {$out} "class add dev %s parent %x: classid %x:1 htb rate %s\n", - $dev, $parent, $parent, $rate; - - foreach my $class (@$classes) { - $class->htbClass($out, $dev, $parent, $rate); - - foreach my $match ($class->matchRules()) { - $match->filter($out, $dev, $parent, 1, $class->{dsmark}); - printf {$out} " classid %x:%x\n", $parent, $class->{id}; - } - } -} - -# Walk configuration tree and look for changed nodes -# The configuration system should do this but doesn't do it right -sub isChanged { - my ($self, $name) = @_; - my $config = new VyattaConfig; - - $config->setLevel("qos-policy traffic-shaper $name"); - - if ($config->isChanged('bandwidth') ) { - return 'bandwidth'; - } - - foreach my $attr ('bandwidth', 'burst', 'ceiling', 'priority', 'queue-limit', 'queue-type') { - if ($config->isChanged("default $attr")) { - return "default $attr"; - } - } - - my %classNodes = $config->listNodeStatus('class'); - while (my ($class, $status) = each %classNodes) { - if ($status ne 'static') { - return "class $class"; - } - - foreach my $attr ('bandwidth', 'burst', 'ceiling', 'priority', 'queue-limit', 'queue-type') { - if ($config->isChanged("class $class $attr")) { - return "class $class $attr"; - } - } - - my %matchNodes = $config->listNodeStatus("class $class match"); - while (my ($match, $status) = each %matchNodes) { - my $level = "class $class match $match"; - if ($status ne 'static') { - return $level; - } - - foreach my $parm ('vif', 'interface', 'ip dscp', 'ip protocol', - 'ip source address', 'ip destination address', - 'ip source port', 'ip destination port') { - if ($config->isChanged("$level $parm")) { - return "$level $parm"; - } - } - } - } - - return undef; # false -} - -1; diff --git a/scripts/VyattaQosUtil.pm b/scripts/VyattaQosUtil.pm deleted file mode 100644 index 82dfd6b..0000000 --- a/scripts/VyattaQosUtil.pm +++ /dev/null @@ -1,293 +0,0 @@ -# Wrappers for iproute2 utilities -# -# **** License **** -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2 as -# published by the Free Software Foundation. -# -# 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. -# -# This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2008 Vyatta, Inc. -# All Rights Reserved. -# **** End License **** - -package VyattaQosUtil; -require Exporter; -@EXPORT = qw/getRate getPercent getBurstSize getProtocol getDsfield getIfIndex interfaceRate/; -use strict; - -sub get_num { - use POSIX qw(strtod); - my ($str) = @_; - $str =~s/^\s+//; - $str =~s/\s+$//; - - $! = 0; - my ($num, $unparsed) = strtod($str); - if (($unparsed == length($str)) || $!) { - return; # undefined (bad input) - } - - if ($unparsed > 0) { return $num, substr($str, -$unparsed); } - else { return $num; } -} - -## get_rate("10mbit") -# convert rate specification to number -# from tc/tc_util.c - -my %rates = ( - 'bit' => 1, - 'kibit' => 1024, - 'kbit' => 1000., - 'mibit' => 1048576., - 'mbit' => 1000000., - 'gibit' => 1073741824., - 'gbit' => 1000000000., - 'tibit' => 1099511627776., - 'tbit' => 1000000000000., - 'bps' => 8., - 'kibps' => 8192., - 'kbps' => 8000., - 'mibps' => 8388608., - 'mbps' => 8000000., - 'gibps' => 8589934592., - 'gbps' => 8000000000., - 'tibps' => 8796093022208., - 'tbps' => 8000000000000., -); - -sub getRate { - my $rate = shift; - my ($num, $suffix) = get_num($rate); - - defined $num - or die "$rate is not a valid bandwidth (not a number)\n"; - ($num >= 0) - or die "$rate is not a valid bandwidth (negative value)\n"; - - if (defined $suffix) { - my $scale = $rates{lc $suffix}; - - if (defined $scale) { - return $num * $scale; - } - - die "$rate is not a valid bandwidth (unknown scale suffix)\n"; - } else { - # No suffix implies Kbps just as IOS - return $num * 1000; - } -} - -sub getPercent { - my $percent = shift; - my ($num, $suffix) = get_num($percent); - - ($suffix eq '%') - or die "$percent incorrect suffix (expect %)\n"; - defined $num - or die "$percent is not a valid percent bandwidth (not a number)\n"; - ($num >= 0) - or die "$percent is not a acceptable percent bandwidth (negative value)\n"; - ($num <= 100) - or die "$percent is not a acceptable percent bandwidth (greater than 100%)\n"; - - return $num; -} - - -# Default time units for tc are usec. -my %timeunits = ( - 's' => 1000000, - 'sec' => 1000000, - 'secs' => 1000000, - 'ms' => 1000, - 'msec' => 1000, - 'msecs' => 1000, - 'us' => 1, - 'usec' => 1, - 'usecs' => 1, -); - -sub getTime { - my $time = shift; - my ($num, $suffix) = get_num($time); - - defined $num - or die "$time is not a valid time interval (not a number)\n"; - ($num >= 0) - or die "$time is not a valid time interval (negative value)\n"; - - if (defined $suffix) { - my $scale = $timeunits{lc $suffix}; - - if (defined $scale) { - return $num * $scale; - } - - die "$time is not a valid time interval (unknown suffix)\n"; - } else { - # No suffix implies ms - return $num * 1000; - } -} - - - -my %scales = ( - 'b' => 1, - 'k' => 1024, - 'kb' => 1024, - 'kbit' => 1024/8, - 'm' => 1024*1024, - 'mb' => 1024*1024, - 'mbit' => 1024*1024/8, - 'g' => 1024*1024*1024, - 'gb' => 1024*1024*1024, -); - -sub getBurstSize { - my $size = shift; - my ($num, $suffix) = get_num($size); - - defined $num - or die "$size is not a valid burst size (not a number)\n"; - - ($num >= 0) - or die "$size is not a valid burst size (negative value)\n"; - - if (defined $suffix) { - my $scale = $scales{lc $suffix}; - defined $scale or - die "$size is not a valid burst size (unknown scale suffix)\n"; - $num *= $scale; - } - - return $num; -} - -sub getProtocol { - my ($str) = @_; - - defined $str or return; - if ($str =~ /^([0-9]+)|(0x[0-9a-fA-F]+)$/) { - if ($str < 0 || $str > 255) { - die "$str is not a valid protocol number\n"; - } - return $str; - } - - my ($name, $aliases, $proto) = getprotobyname($str); - (defined $proto) or die "\"$str\" unknown protocol\n"; - return $proto; -} - -# Parse /etc/iproute/rt_dsfield -# return a hex string "0x10" or undefined -sub getDsfield { - my ($str) = @_; - my $match = undef; - my $dsFileName = '/etc/iproute2/rt_dsfield'; - - defined $str or return; - - # match number (or hex) - if ($str =~ /^([0-9]+)|(0x[0-9a-fA-F]+)$/) { - if ($str < 0 || $str > 63) { - die "$str is not a valid DSCP value\n"; - } - # convert DSCP value to header value used by iproute - return $str << 2; - } - - open my $ds, '<', $dsFileName || die "Can't open $dsFileName, $!\n"; - while (<$ds>) { - next if /^#/; - chomp; - my ($value, $name) = split; - if ($str eq $name) { - $match = $value; - last; - } - } - close($ds) or die "read $dsFileName error\n"; - - (defined $match) or die "\"$str\" unknown DSCP value\n"; - return $match; -} - -sub getIfIndex { - my ($str) = @_; - - defined $str or return; - open my $sysfs, "<", "/sys/class/net/$str/ifindex" || die "Unknown interface $str\n"; - my $ifindex = <$sysfs>; - close($sysfs) or die "read sysfs error\n"; - chomp $ifindex; - return $ifindex; -} - - -## interfaceRate("eth0") -# return result in bits per second -sub interfaceRate { - my ($interface) = @_; - my $speed; - my $config = new VyattaConfig; - - $config->setLevel("interfaces ethernet"); - if ($config->exists("$interface")) { - $speed = $config->returnValue("$interface speed"); - if (defined($speed) && $speed ne "auto") { - return $speed * 1000000; - } - } - - # During boot it may take time for auto-negotiation - for (my $retries = 0; $retries < 5; $retries++) { - $speed = ethtoolRate($interface); - if (defined $speed) { - last; - } - sleep 1; - } - - return $speed; -} - -## ethtoolRate("eth0") -# Fetch actual rate using ethtool and format to valid tc rate -sub ethtoolRate { - my $dev = shift; - my $rate = undef; - - # Get rate of real device (ignore vlan) - $dev =~ s/\.[0-9]+$//; - - open(my $ethtool, "/usr/sbin/ethtool $dev 2>/dev/null |") - or die "ethtool failed: $!\n"; - - # ethtool produces: - # - # Settings for eth1: - # Supported ports: [ TP ] - # ... - # Speed: 1000Mb/s - while (<$ethtool>) { - my @line = split; - if ($line[0] =~ /^Speed:/) { - if ($line[1] =~ /[0-9]+Mb\/s/ ) { - $rate = $line[1]; - $rate =~ s#Mb/s#000000#; - } - last; - } - } - close $ethtool; - return $rate; -} diff --git a/scripts/vyatta-qos-util.pl b/scripts/vyatta-qos-util.pl index 8c3bafd..a19baee 100755 --- a/scripts/vyatta-qos-util.pl +++ b/scripts/vyatta-qos-util.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#! /usr/bin/perl # # Utility routines for validating input # These functions don't change existing QoS parameters @@ -18,62 +18,43 @@ # All Rights Reserved. # **** End License **** -use lib "/opt/vyatta/share/perl5/"; -use VyattaQosUtil; +use lib "/opt/vyatta/share/perl5"; +use Vyatta::Qos::Util qw( getPercent getRate getBurstSize getProtocol + getDsfield getTime ); use Getopt::Long; -my ($percent, $rate, $burst, $protocol, $dsfield, $time); - -GetOptions( - "percent-or-rate=s" => \$percent, - "rate=s" => \$rate, - "burst=s" => \$burst, - "protocol=s" => \$protocol, - "dscp=s" => \$dsfield, - "tos=s" => \$dsfield, - "time=s" => \$time, -); - -if ( defined $percent ) { - if ($percent =~ /%$/) { - my $p = VyattaQosUtil::getPercent($percent); - } else { - my $r = VyattaQosUtil::getRate($percent); +sub getPercentOrRate { + my $percent = shift; + if ( $percent =~ /%$/ ) { + return getPercent($percent); + } + else { + return getRate($percent); } - exit 0; -} - -if ( defined $rate ) { - my $r = VyattaQosUtil::getRate($rate); - exit 0; -} - -if ( defined $burst ) { - my $b = VyattaQosUtil::getBurstSize($burst); - exit 0; -} - -if ( defined $protocol ) { - my $p = VyattaQosUtil::getProtocol($protocol); - exit 0; } -if ( defined $dsfield ) { - my $d = VyattaQosUtil::getDsfield($dsfield); - exit 0; +sub usage { + print <<EOF; + usage: + vyatta-qos-util.pl --percent value + vyatta-qos-util.pl --percent-or-rate value + vyatta-qos-util.pl --rate rate + vyatta-qos-util.pl --time time + vyatta-qos-util.pl --burst size + vyatta-qos-util.pl --protocol protocol + vyatta-qos-util.pl --dscp tos|dsfield +EOF + exit 1; } -if ( defined $time ) { - my $t = VyattaQosUtil::getTime($time); - exit 0; -} +GetOptions( + "percent=s" => sub { getPercent( $_[1] ); }, + "percent-or-rate=s" => sub { getPercentOrRate( $_[1] ); }, + "rate=s" => sub { getRate( $_[1] ); }, + "burst=s" => sub { getBurstSize( $_[1] ); }, + "protocol=s" => sub { getProtocol( $_[1] ); }, + "dscp=s" => sub { getDsfield( $_[1] ); }, + "tos=s" => sub { getDsfield( $_[1] ); }, + "time=s" => sub { getTime( $_[1] ); }, +) or usage(); -print <<EOF; -usage: vyatta-qos-util.pl --percent-or-rate value - vyatta-qos-util.pl --rate rate - vyatta-qos-util.pl --time time - vyatta-qos-util.pl --burst size - vyatta-qos-util.pl --protocol protocol - vyatta-qos-util.pl --dscp tos|dsfield -EOF -exit 1; diff --git a/scripts/vyatta-qos.pl b/scripts/vyatta-qos.pl index 29a86d0..3437b1b 100755 --- a/scripts/vyatta-qos.pl +++ b/scripts/vyatta-qos.pl @@ -14,7 +14,7 @@ # All Rights Reserved. # **** End License **** -use lib "/opt/vyatta/share/perl5/"; +use lib "/opt/vyatta/share/perl5"; use VyattaConfig; use strict; @@ -41,43 +41,45 @@ GetOptions( my %policies = ( 'out' => { - 'traffic-shaper' => 'VyattaQosTrafficShaper', - 'fair-queue' => 'VyattaQosFairQueue', - 'rate-limit' => 'VyattaQosRateLimiter', - 'drop-tail' => 'VyattaQosDropTail', + 'traffic-shaper' => 'TrafficShaper', + 'fair-queue' => 'FairQueue', + 'rate-limit' => 'RateLimiter', + 'drop-tail' => 'DropTail', }, 'in' => { - 'traffic-limiter' => 'VyattaQosTrafficLimiter', + 'traffic-limiter' => 'TrafficLimiter', } ); # class factory for policies sub make_policy { my ($config, $type, $name, $direction) = @_; - my $class; + my $policy_type; if ($direction) { - $class = $policies{$direction}{$type}; + $policy_type = $policies{$direction}{$type}; } else { foreach $direction (keys %policies) { - $class = $policies{$direction}{$type}; - last if defined $class; + $policy_type = $policies{$direction}{$type}; + last if defined $policy_type; } } # This means template exists but we don't know what it is. - if (! defined $class) { + if (! defined $policy_type) { foreach $direction (keys %policies) { die "QoS policy $name is type $type and is only valid for $direction\n" if defined $policies{$direction}{$type}; } die "QoS policy $name has not been created\n"; } + $config->setLevel("qos-policy $type $name"); + + my $location = "Vyatta/Qos/$policy_type.pm"; + my $class = "Vyatta::Qos::$policy_type"; - my $location = "$class.pm"; require $location; - $config->setLevel("qos-policy $type $name"); return $class->new($config, $name, $direction); } |