From 790663c88fb291ddb5b645bdde62d8229d5e115b Mon Sep 17 00:00:00 2001 From: Stephen Hemminger Date: Thu, 20 Nov 2008 12:16:02 -0800 Subject: Change perl module names from VyattaQosXXX to Vyatta::Qos:XXX Use more multi-level directory hierarchy instead of having all modules at top level. --- Makefile.am | 16 +- lib/Vyatta/Qos/DropTail.pm | 58 +++++ lib/Vyatta/Qos/FairQueue.pm | 68 ++++++ lib/Vyatta/Qos/Match.pm | 102 ++++++++ lib/Vyatta/Qos/RateLimiter.pm | 72 ++++++ lib/Vyatta/Qos/TrafficLimiter.pm | 194 ++++++++++++++++ lib/Vyatta/Qos/TrafficShaper.pm | 462 +++++++++++++++++++++++++++++++++++++ lib/Vyatta/Qos/Util.pm | 302 ++++++++++++++++++++++++ scripts/VyattaQosDropTail.pm | 57 ----- scripts/VyattaQosFairQueue.pm | 66 ------ scripts/VyattaQosMatch.pm | 100 -------- scripts/VyattaQosRateLimiter.pm | 71 ------ scripts/VyattaQosTrafficLimiter.pm | 195 ---------------- scripts/VyattaQosTrafficShaper.pm | 461 ------------------------------------ scripts/VyattaQosUtil.pm | 293 ----------------------- scripts/vyatta-qos-util.pl | 85 +++---- scripts/vyatta-qos.pl | 28 +-- 17 files changed, 1314 insertions(+), 1316 deletions(-) create mode 100644 lib/Vyatta/Qos/DropTail.pm create mode 100644 lib/Vyatta/Qos/FairQueue.pm create mode 100644 lib/Vyatta/Qos/Match.pm create mode 100644 lib/Vyatta/Qos/RateLimiter.pm create mode 100644 lib/Vyatta/Qos/TrafficLimiter.pm create mode 100644 lib/Vyatta/Qos/TrafficShaper.pm create mode 100644 lib/Vyatta/Qos/Util.pm delete mode 100644 scripts/VyattaQosDropTail.pm delete mode 100644 scripts/VyattaQosFairQueue.pm delete mode 100644 scripts/VyattaQosMatch.pm delete mode 100644 scripts/VyattaQosRateLimiter.pm delete mode 100644 scripts/VyattaQosTrafficLimiter.pm delete mode 100644 scripts/VyattaQosTrafficShaper.pm delete mode 100644 scripts/VyattaQosUtil.pm diff --git a/Makefile.am b/Makefile.am index 0257672..950d05f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,16 +1,16 @@ cfgdir = $(datadir)/vyatta-cfg/templates -share_perl5dir = /opt/vyatta/share/perl5 +share_perl5dir = /opt/vyatta/share/perl5/Vyatta/Qos sbin_SCRIPTS = scripts/vyatta-qos.pl sbin_SCRIPTS += scripts/vyatta-qos-util.pl -share_perl5_DATA = scripts/VyattaQosUtil.pm -share_perl5_DATA += scripts/VyattaQosFairQueue.pm -share_perl5_DATA += scripts/VyattaQosTrafficShaper.pm -share_perl5_DATA += scripts/VyattaQosMatch.pm -share_perl5_DATA += scripts/VyattaQosRateLimiter.pm -share_perl5_DATA += scripts/VyattaQosDropTail.pm -share_perl5_DATA += scripts/VyattaQosTrafficLimiter.pm +share_perl5_DATA = lib/Vyatta/Qos/Util.pm +share_perl5_DATA += lib/Vyatta/Qos/FairQueue.pm +share_perl5_DATA += lib/Vyatta/Qos/TrafficShaper.pm +share_perl5_DATA += lib/Vyatta/Qos/Match.pm +share_perl5_DATA += lib/Vyatta/Qos/RateLimiter.pm +share_perl5_DATA += lib/Vyatta/Qos/DropTail.pm +share_perl5_DATA += lib/Vyatta/Qos/TrafficLimiter.pm cpiop = find . ! -regex '\(.*~\|.*\.bak\|.*\.swp\|.*\#.*\#\)' -print0 | \ cpio -0pd diff --git a/lib/Vyatta/Qos/DropTail.pm b/lib/Vyatta/Qos/DropTail.pm new file mode 100644 index 0000000..b8ef0b1 --- /dev/null +++ b/lib/Vyatta/Qos/DropTail.pm @@ -0,0 +1,58 @@ +# 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 Vyatta::Qos::DropTail; + +use strict; +use warnings; + +require VyattaConfig; + +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/lib/Vyatta/Qos/FairQueue.pm b/lib/Vyatta/Qos/FairQueue.pm new file mode 100644 index 0000000..9897e29 --- /dev/null +++ b/lib/Vyatta/Qos/FairQueue.pm @@ -0,0 +1,68 @@ +# 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 Vyatta::Qos::FairQueue; + +use strict; +use warnings; + +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/lib/Vyatta/Qos/Match.pm b/lib/Vyatta/Qos/Match.pm new file mode 100644 index 0000000..08a0ff4 --- /dev/null +++ b/lib/Vyatta/Qos/Match.pm @@ -0,0 +1,102 @@ +# **** 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 Vyatta::Qos::Match; +require VyattaConfig; +use Vyatta::Qos::Util qw(getIfIndex getDSfield getProtocol); + +use strict; +use warnings; + +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} = getIfIndex($config->returnValue("interface")); + + if ($config->exists("ip")) { + my %ip; + + $ip{dsfield} = getDsfield( $config->returnValue("ip dscp")); + $ip{protocol} = 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/lib/Vyatta/Qos/RateLimiter.pm b/lib/Vyatta/Qos/RateLimiter.pm new file mode 100644 index 0000000..625db62 --- /dev/null +++ b/lib/Vyatta/Qos/RateLimiter.pm @@ -0,0 +1,72 @@ +# 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 Vyatta::Qos::RateLimiter; + +use strict; +use warnings; + +use VyattaConfig; +use Vyatta::Qos::Util qw/getRate getTime/; + +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} = 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} = 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/lib/Vyatta/Qos/TrafficLimiter.pm b/lib/Vyatta/Qos/TrafficLimiter.pm new file mode 100644 index 0000000..8564e87 --- /dev/null +++ b/lib/Vyatta/Qos/TrafficLimiter.pm @@ -0,0 +1,194 @@ +# 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 Vyatta::Qos::Match; + use Vyatta::Qos::Util qw/getRate/; + + 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} = getRate($rate); + + $self->{priority} = $config->returnValue("priority"); + + 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; + } + +} + +package Vyatta::Qos::TrafficLimiter; +use strict; +require VyattaConfig; + +my %fields = ( + _level => undef, + _classes => undef, +); + +# 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/lib/Vyatta/Qos/TrafficShaper.pm b/lib/Vyatta/Qos/TrafficShaper.pm new file mode 100644 index 0000000..3c8f123 --- /dev/null +++ b/lib/Vyatta/Qos/TrafficShaper.pm @@ -0,0 +1,462 @@ +# 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 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 VyattaConfig; +use Vyatta::Qos::Util qw/getRate interfaceRate/; + + +my %fields = ( + _level => undef, + _rate => undef, + _classes => undef, +); + +# 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 = 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 = interfaceRate($dev); + if (! defined $rate ) { + print STDERR "Interface $dev speed cannot be determined (assuming 10mbit)\n"; + $rate = 10000000; + } + } else { + $rate = 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/lib/Vyatta/Qos/Util.pm b/lib/Vyatta/Qos/Util.pm new file mode 100644 index 0000000..28df9f1 --- /dev/null +++ b/lib/Vyatta/Qos/Util.pm @@ -0,0 +1,302 @@ +# 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 Vyatta::Qos::Util; +our @EXPORT = qw(getRate getPercent getBurstSize getProtocol getDsfield getTime); +our @EXPORT_OK = qw(interfaceRate getIfIndex); +use base qw(Exporter); + +use strict; +use warnings; + +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; +} + +1; 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 < 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 < { - '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); } -- cgit v1.2.3