diff options
| -rw-r--r-- | Makefile.am | 16 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/DropTail.pm (renamed from scripts/VyattaQosDropTail.pm) | 7 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/FairQueue.pm (renamed from scripts/VyattaQosFairQueue.pm) | 4 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/Match.pm (renamed from scripts/VyattaQosMatch.pm) | 12 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/RateLimiter.pm (renamed from scripts/VyattaQosRateLimiter.pm) | 11 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/TrafficLimiter.pm (renamed from scripts/VyattaQosTrafficLimiter.pm) | 11 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/TrafficShaper.pm (renamed from scripts/VyattaQosTrafficShaper.pm) | 23 | ||||
| -rw-r--r-- | lib/Vyatta/Qos/Util.pm | 302 | ||||
| -rw-r--r-- | scripts/VyattaQosUtil.pm | 293 | ||||
| -rwxr-xr-x | scripts/vyatta-qos-util.pl | 85 | ||||
| -rwxr-xr-x | scripts/vyatta-qos.pl | 28 |
11 files changed, 395 insertions, 397 deletions
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/scripts/VyattaQosDropTail.pm b/lib/Vyatta/Qos/DropTail.pm index 1345fb0..b8ef0b1 100644 --- a/scripts/VyattaQosDropTail.pm +++ b/lib/Vyatta/Qos/DropTail.pm @@ -16,11 +16,12 @@ # All Rights Reserved. # **** End License **** -package VyattaQosDropTail; +package Vyatta::Qos::DropTail; use strict; +use warnings; + require VyattaConfig; -use VyattaQosUtil; my %fields = ( _limit => undef, @@ -32,7 +33,7 @@ sub new { my $class = ref($that) || $that; my $self = {%fields}; - $self->{_limit} = $config->returnValue("queue-limit"); + $self->{_limit} = $config->returnValue("queue-limit"); return bless $self, $class; } diff --git a/scripts/VyattaQosFairQueue.pm b/lib/Vyatta/Qos/FairQueue.pm index 278bb77..9897e29 100644 --- a/scripts/VyattaQosFairQueue.pm +++ b/lib/Vyatta/Qos/FairQueue.pm @@ -18,9 +18,10 @@ # All Rights Reserved. # **** End License **** -package VyattaQosFairQueue; +package Vyatta::Qos::FairQueue; use strict; +use warnings; require VyattaConfig; @@ -63,4 +64,5 @@ sub isChanged { } return undef; # false } + 1; diff --git a/scripts/VyattaQosMatch.pm b/lib/Vyatta/Qos/Match.pm index 9c9945d..08a0ff4 100644 --- a/scripts/VyattaQosMatch.pm +++ b/lib/Vyatta/Qos/Match.pm @@ -13,10 +13,12 @@ # All Rights Reserved. # **** End License **** -package VyattaQosMatch; +package Vyatta::Qos::Match; require VyattaConfig; -use VyattaQosUtil; +use Vyatta::Qos::Util qw(getIfIndex getDSfield getProtocol); + use strict; +use warnings; my %fields = ( _dev => undef, @@ -40,13 +42,13 @@ sub _define { my $level = $config->setLevel(); $self->{_vif} = $config->returnValue("vif"); - $self->{_dev} = VyattaQosUtil::getIfIndex($config->returnValue("interface")); + $self->{_dev} = 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{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"); diff --git a/scripts/VyattaQosRateLimiter.pm b/lib/Vyatta/Qos/RateLimiter.pm index f519683..625db62 100644 --- a/scripts/VyattaQosRateLimiter.pm +++ b/lib/Vyatta/Qos/RateLimiter.pm @@ -16,12 +16,13 @@ # All Rights Reserved. # **** End License **** -package VyattaQosRateLimiter; +package Vyatta::Qos::RateLimiter; use strict; +use warnings; -require VyattaConfig; -use VyattaQosUtil; +use VyattaConfig; +use Vyatta::Qos::Util qw/getRate getTime/; my %fields = ( _rate => undef, @@ -35,13 +36,13 @@ sub new { my $class = ref($that) || $that; my $self = {%fields}; - $self->{_rate} = VyattaQosUtil::getRate($config->returnValue("bandwidth")); + $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} = VyattaQosUtil::getTime($config->returnValue("latency")); + $self->{_latency} = getTime($config->returnValue("latency")); defined $self->{_latency} or die "$level latency not defined\n"; return bless $self, $class; diff --git a/scripts/VyattaQosTrafficLimiter.pm b/lib/Vyatta/Qos/TrafficLimiter.pm index 2907590..8564e87 100644 --- a/scripts/VyattaQosTrafficLimiter.pm +++ b/lib/Vyatta/Qos/TrafficLimiter.pm @@ -21,7 +21,8 @@ package LimiterClass; use strict; require VyattaConfig; - use VyattaQosMatch; + use Vyatta::Qos::Match; + use Vyatta::Qos::Util qw/getRate/; my %fields = ( id => undef, @@ -50,13 +51,13 @@ my $rate = $config->returnValue("bandwidth"); defined $rate or die "bandwidth must be defined for $level\n"; - $self->{rate} = VyattaQosUtil::getRate($rate); + $self->{rate} = getRate($rate); $self->{priority} = $config->returnValue("priority"); foreach my $match ( $config->listNodes("match") ) { $config->setLevel("$level match $match"); - push @matches, new VyattaQosMatch($config); + push @matches, new Vyatta::Qos::Match($config); } $self->{_match} = \@matches; } @@ -69,17 +70,15 @@ } -package VyattaQosTrafficLimiter; +package Vyatta::Qos::TrafficLimiter; 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 ) = @_; diff --git a/scripts/VyattaQosTrafficShaper.pm b/lib/Vyatta/Qos/TrafficShaper.pm index 5f9fe75..3c8f123 100644 --- a/scripts/VyattaQosTrafficShaper.pm +++ b/lib/Vyatta/Qos/TrafficShaper.pm @@ -22,7 +22,8 @@ package ShaperClass; use strict; require VyattaConfig; - use VyattaQosMatch; + use Vyatta::Qos::Match; + use Vyatta::Qos::Util qw/getDsfield getRate/; my %fields = ( id => undef, @@ -63,12 +64,11 @@ $self->{_limit} = $config->returnValue("queue-limit"); $self->{_qdisc} = $config->returnValue("queue-type"); - $self->{dsmark} = - VyattaQosUtil::getDsfield($config->returnValue("set-dscp")); + $self->{dsmark} = getDsfield($config->returnValue("set-dscp")); foreach my $match ($config->listNodes("match")) { $config->setLevel("$level match $match"); - push @matches, new VyattaQosMatch($config); + push @matches, new Vyatta::Qos::Match($config); } $self->{_match} = \@matches; } @@ -95,7 +95,7 @@ $rate = ( $percent * $speed ) / 100.; } else { - $rate = VyattaQosUtil::getRate($rate); + $rate = getRate($rate); } return $rate; @@ -232,10 +232,12 @@ } -package VyattaQosTrafficShaper; +package Vyatta::Qos::TrafficShaper; use strict; + require VyattaConfig; -use VyattaQosUtil; +use Vyatta::Qos::Util qw/getRate interfaceRate/; + my %fields = ( _level => undef, @@ -243,7 +245,6 @@ my %fields = ( _classes => undef, ); -# new VyattaQosTrafficShaper($config) # Create a new instance based on config information sub new { my ( $that, $config, $name ) = @_; @@ -264,7 +265,7 @@ sub _validate { if ( $self->{_rate} ne "auto" ) { my $classes = $self->{_classes}; my $default = shift @$classes; - my $rate = VyattaQosUtil::getRate($self->{_rate}); + my $rate = getRate($self->{_rate}); $default->rateCheck($rate, "$self->{_level} default"); @@ -280,13 +281,13 @@ sub _getAutoRate { my ($rate, $dev) = @_; if ( $rate eq "auto" ) { - $rate = VyattaQosUtil::interfaceRate($dev); + $rate = interfaceRate($dev); if (! defined $rate ) { print STDERR "Interface $dev speed cannot be determined (assuming 10mbit)\n"; $rate = 10000000; } } else { - $rate = VyattaQosUtil::getRate($rate); + $rate = getRate($rate); } return $rate; 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/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); } |