From 97c6b53404e71fe1b6ccb617dafea346f8211ee4 Mon Sep 17 00:00:00 2001 From: Stephen Hemminger Date: Tue, 20 Jul 2010 08:59:52 -0700 Subject: Use perltidy to cleanup indentation --- lib/Vyatta/Qos/Match.pm | 145 ++++++++++++++++++++------------------- lib/Vyatta/Qos/ShaperClass.pm | 95 +++++++++++++------------ lib/Vyatta/Qos/TrafficLimiter.pm | 34 +++++---- lib/Vyatta/Qos/TrafficShaper.pm | 18 ++--- lib/Vyatta/Qos/Util.pm | 54 ++++++--------- 5 files changed, 171 insertions(+), 175 deletions(-) (limited to 'lib') diff --git a/lib/Vyatta/Qos/Match.pm b/lib/Vyatta/Qos/Match.pm index a3842f6..4406b98 100644 --- a/lib/Vyatta/Qos/Match.pm +++ b/lib/Vyatta/Qos/Match.pm @@ -21,17 +21,17 @@ use strict; use warnings; sub getPort { - my ($str, $proto) = @_; + my ( $str, $proto ) = @_; return unless defined($str); if ( $str =~ /^([0-9]+)|(0x[0-9a-fA-F]+)$/ ) { - die "$str is not a valid port number\n" - if ( $str <= 0 || $str > 65535 ); + die "$str is not a valid port number\n" + if ( $str <= 0 || $str > 65535 ); return $str; } - + $proto = "tcp" unless $proto; - my $port = getservbyname($str, $proto); + my $port = getservbyname( $str, $proto ); die "$str unknown $proto port name\n" unless $port; return $port; @@ -52,24 +52,25 @@ sub new { if ( $af eq 'ether' ) { $fields{protocol} = $config->returnValue("ether protocol"); - $fields{src} = $config->returnValue("ether source"); - $fields{dst} = $config->returnValue("ether destination"); + $fields{src} = $config->returnValue("ether source"); + $fields{dst} = $config->returnValue("ether destination"); } else { - $fields{dsfield} = - getDsfield( $config->returnValue("$af dscp") ); - my $ipprot = $config->returnValue("$af protocol"); + $fields{dsfield} = getDsfield( $config->returnValue("$af dscp") ); + my $ipprot = $config->returnValue("$af protocol"); $fields{protocol} = getProtocol($ipprot); - $fields{src} = $config->returnValue("$af source address"); - $fields{dst} = $config->returnValue("$af destination address"); - $fields{sport} = getPort($config->returnValue("$af source port"), $ipprot); - $fields{dport} = getPort($config->returnValue("$af destination port"), $ipprot); + $fields{src} = $config->returnValue("$af source address"); + $fields{dst} = $config->returnValue("$af destination address"); + $fields{sport} = + getPort( $config->returnValue("$af source port"), $ipprot ); + $fields{dport} = + getPort( $config->returnValue("$af destination port"), $ipprot ); } $self->{$af} = \%fields; - die "Can not match on both $af and $lastaf protocol in same match\n" - if $lastaf; - $lastaf = $af; + die "Can not match on both $af and $lastaf protocol in same match\n" + if $lastaf; + $lastaf = $af; } my $vif = $config->returnValue("vif"); @@ -82,10 +83,10 @@ sub new { $self->{_fwmark} = $fwmark; if ($lastaf) { - die "Can not combine protocol and vlan tag match\n" - if ($vif); - die "Can not combine protocol and interface match\n" - if ($iif); + die "Can not combine protocol and vlan tag match\n" + if ($vif); + die "Can not combine protocol and interface match\n" + if ($iif); } return $self; @@ -105,12 +106,12 @@ sub filter { next unless $ip && $$ip{dsfield}; printf "filter add dev %s parent %x: protocol %s prio $prio", - $dev, $parent, $ipver; + $dev, $parent, $ipver; printf " handle %s tcindex classid %x:%x\n", - $$ip{dsfield}, $parent, $classid; + $$ip{dsfield}, $parent, $classid; - $prio += 1; - } + $prio += 1; + } return; } @@ -119,43 +120,44 @@ sub filter { my $p = $self->{$proto}; next unless $p; - printf "filter add dev %s parent %x: prio %d", $dev, $parent, $prio; - if ($proto eq 'ether') { - my $type = $$p{protocol}; - $type = 'all' unless $type; - - if (defined($$p{src}) || defined($$p{dest})) { - print " protocol $type u32"; - print " match ether src $$p{src}" if $$p{src}; - print " match ether dst $$p{dst}" if $$p{dst}; - } else { - # u32 requires some options to work but basic works - print " protocol $type basic"; - } - } else { - print " protocol all u32"; - - # workaround inconsistent usage in tc u32 match - my $sel = $proto; - if ($proto eq 'ipv6') { - $sel = 'ip6'; - printf " match u16 0x%x 0x0ff0 at 0", hex($$p{dsfield}) << 4, - if $$p{dsfield}; - } else { - print " match $sel dsfield $$p{dsfield} 0xff" if $$p{dsfield}; - } - print " match $sel protocol $$p{protocol} 0xff" if $$p{protocol}; - - print " match $sel src $$p{src}" if $$p{src}; - print " match $sel sport $$p{sport} 0xffff" if $$p{sport}; - print " match $sel dst $$p{dst}" if $$p{dst}; - print " match $sel dport $$p{dport} 0xffff" if $$p{dport}; - } - - print " match mark $fwmark 0xff" if $fwmark; - print " $police" if $police; - printf " flowid %x:%x\n", $parent, $classid; - return; + printf "filter add dev %s parent %x: prio %d", $dev, $parent, $prio; + if ( $proto eq 'ether' ) { + my $type = $$p{protocol}; + $type = 'all' unless $type; + + if ( defined( $$p{src} ) || defined( $$p{dest} ) ) { + print " protocol $type u32"; + print " match ether src $$p{src}" if $$p{src}; + print " match ether dst $$p{dst}" if $$p{dst}; + } else { + + # u32 requires some options to work but basic works + print " protocol $type basic"; + } + } else { + print " protocol all u32"; + + # workaround inconsistent usage in tc u32 match + my $sel = $proto; + if ( $proto eq 'ipv6' ) { + $sel = 'ip6'; + printf " match u16 0x%x 0x0ff0 at 0", hex( $$p{dsfield} ) << 4, + if $$p{dsfield}; + } else { + print " match $sel dsfield $$p{dsfield} 0xff" if $$p{dsfield}; + } + print " match $sel protocol $$p{protocol} 0xff" if $$p{protocol}; + + print " match $sel src $$p{src}" if $$p{src}; + print " match $sel sport $$p{sport} 0xffff" if $$p{sport}; + print " match $sel dst $$p{dst}" if $$p{dst}; + print " match $sel dport $$p{dport} 0xffff" if $$p{dport}; + } + + print " match mark $fwmark 0xff" if $fwmark; + print " $police" if $police; + printf " flowid %x:%x\n", $parent, $classid; + return; } my $indev = $self->{_indev}; @@ -165,15 +167,16 @@ sub filter { print " protocol all basic"; print " match meta\(rt_iif eq $indev\)" if $indev; print " match meta\(vlan mask 0xfff eq $vif\)" if $vif; - print " match meta\(fwmark eq $fwmark\)" if $fwmark; - - print " $police" if $police; - printf " flowid %x:%x\n", $parent, $classid; - } elsif ( $fwmark ) { - printf "filter add dev %s parent %x: prio %d", $dev, $parent, $prio; - printf " protocol all handle %d fw", $fwmark; - print " $police" if $police; - printf " flowid %x:%x\n", $parent, $classid; + print " match meta\(fwmark eq $fwmark\)" if $fwmark; + + print " $police" if $police; + printf " flowid %x:%x\n", $parent, $classid; + } + elsif ($fwmark) { + printf "filter add dev %s parent %x: prio %d", $dev, $parent, $prio; + printf " protocol all handle %d fw", $fwmark; + print " $police" if $police; + printf " flowid %x:%x\n", $parent, $classid; } } diff --git a/lib/Vyatta/Qos/ShaperClass.pm b/lib/Vyatta/Qos/ShaperClass.pm index 0eaede2..7082aa3 100644 --- a/lib/Vyatta/Qos/ShaperClass.pm +++ b/lib/Vyatta/Qos/ShaperClass.pm @@ -24,35 +24,35 @@ use Vyatta::Qos::Match; use Vyatta::Qos::Util qw/getDsfield getRate/; use constant { - AVGPKT => 1024, # Average packet size for RED calculations - LATENCY => 250, # Worstcase latency for RED (ms) + AVGPKT => 1024, # Average packet size for RED calculations + LATENCY => 250, # Worstcase latency for RED (ms) }; sub new { my ( $that, $config, $id ) = @_; - my $class = ref($that) || $that; - my $self = { }; + my $class = ref($that) || $that; + my $self = {}; $self->{id} = $id; bless $self, $class; - + if ($config) { - my $level = $config->setLevel(); - - $self->{level} = $level; - $self->{_rate} = $config->returnValue("bandwidth"); - $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->{_avgpkt} = $config->returnValue("packet-length"); - $self->{_latency} = $config->returnValue("latency"); - - $self->{dsmark} = getDsfield( $config->returnValue("set-dscp") ); - my @matches = _getMatch("$level match"); - $self->{_match} = \@matches; + my $level = $config->setLevel(); + + $self->{level} = $level; + $self->{_rate} = $config->returnValue("bandwidth"); + $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->{_avgpkt} = $config->returnValue("packet-length"); + $self->{_latency} = $config->returnValue("latency"); + + $self->{dsmark} = getDsfield( $config->returnValue("set-dscp") ); + my @matches = _getMatch("$level match"); + $self->{_match} = \@matches; } return $self; @@ -78,7 +78,7 @@ sub matchRules { sub _getPercentRate { my ( $rate, $speed ) = @_; - return unless $rate; # no rate defined; + return unless $rate; # no rate defined; # Rate might be a percentage of speed if ( $rate =~ /%$/ ) { @@ -122,24 +122,24 @@ sub rateCheck { } my $qlimit = $self->{_limit}; - if ($self->{_qdisc} eq 'random-detect') { - my $qmax = redQsize($rate); - if (defined($qlimit) && $qlimit * AVGPKT < $qmax) { - print STDERR "Configuration error in: $level\n"; - printf STDERR + if ( $self->{_qdisc} eq 'random-detect' ) { + my $qmax = redQsize($rate); + if ( defined($qlimit) && $qlimit * AVGPKT < $qmax ) { + print STDERR "Configuration error in: $level\n"; + printf STDERR "The queue limit (%d) is too small, must be greater than %d when using random-detect\n", - $level, $qmax / AVGPKT; - exit 1; - } + $level, $qmax / AVGPKT; + exit 1; + } - if ($qmax < 3 * AVGPKT) { - my $minbw = (3 * AVGPKT * 8) / LATENCY; + if ( $qmax < 3 * AVGPKT ) { + my $minbw = ( 3 * AVGPKT * 8 ) / LATENCY; - print STDERR "Configuration error in: $level\n"; - die + print STDERR "Configuration error in: $level\n"; + die "Random-detect queue type requires effective bandwidth of %d Kbit/sec or greater\n", - $minbw; - } + $minbw; + } } } @@ -180,7 +180,7 @@ sub fifoQdisc { # latency = 100ms # # Bandwidth (bits/sec) * Latency (ms) -# Maximum Threshold = -------------------------------------- +# Maximum Threshold = -------------------------------------- # (bytes) 8 bits/byte * 1000 ms/sec # # Minimum Threshold = Maximum Threshold / 3 @@ -192,22 +192,21 @@ sub fifoQdisc { # http://www.icir.org/floyd/REDparameters.txt sub redQsize { my $bw = shift; - - return ($bw * LATENCY) / (8 * 1000); -} + + return ( $bw * LATENCY ) / ( 8 * 1000 ); +} sub redQdisc { my ( $self, $dev, $rate ) = @_; - my $qmax = (defined $rate) ? redQsize( $rate ) : (18 * AVGPKT); + my $qmax = ( defined $rate ) ? redQsize($rate) : ( 18 * AVGPKT ); my $qmin = $qmax / 3; $qmin = AVGPKT if $qmin < AVGPKT; - my $burst = ( 2 * $qmin + $qmax ) / (3 * AVGPKT); - my $limit = $self->{_limit}; - my $qlimit = (defined $limit) ? ($limit * AVGPKT) : (4 * $qmax); + my $burst = ( 2 * $qmin + $qmax ) / ( 3 * AVGPKT ); + my $limit = $self->{_limit}; + my $qlimit = ( defined $limit ) ? ( $limit * AVGPKT ) : ( 4 * $qmax ); - printf "red limit %d min %d max %d avpkt %d", - $qlimit, $qmin, $qmax, AVGPKT; + printf "red limit %d min %d max %d avpkt %d", $qlimit, $qmin, $qmax, AVGPKT; printf " burst %d probability 0.1 bandwidth %s ecn\n", $burst, $rate; } @@ -219,7 +218,7 @@ my %qdiscOptions = ( ); sub get_rate { - my ($self, $speed) = @_; + my ( $self, $speed ) = @_; return _getPercentRate( $self->{_rate}, $speed ); } @@ -242,11 +241,11 @@ sub gen_class { sub gen_leaf { my ( $self, $dev, $parent, $rate ) = @_; my $qtype = $self->{_qdisc}; - return unless $qtype; # default is okay + return unless $qtype; # default is okay my $q = $qdiscOptions{$qtype}; die "Unknown queue-type $qtype\n" - unless $q; + unless $q; printf "qdisc add dev %s parent %x:%x ", $dev, $parent, $self->{id}; $q->( $self, $dev, $rate ); diff --git a/lib/Vyatta/Qos/TrafficLimiter.pm b/lib/Vyatta/Qos/TrafficLimiter.pm index b731c64..c30cbb9 100644 --- a/lib/Vyatta/Qos/TrafficLimiter.pm +++ b/lib/Vyatta/Qos/TrafficLimiter.pm @@ -53,8 +53,9 @@ sub _define { 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") ) { - next if ($type eq 'description'); + foreach my $type ( $config->listNodes("class $class match $match") ) + { + next if ( $type eq 'description' ); $matchTypes{$type} = "$class match $match"; } } @@ -68,8 +69,8 @@ sub _define { die "$level can not match on both ip and other types\n"; } - if ($config->exists('default')) { - $config->setLevel("$level default"); + if ( $config->exists('default') ) { + $config->setLevel("$level default"); push @classes, new Vyatta::Qos::LimiterClass( $config, 0 ); } @@ -86,31 +87,34 @@ sub commands { my $parent; die "traffic-policy limiter only applies for incoming traffic\n" - unless ($direction eq 'in'); + unless ( $direction eq 'in' ); - $parent = 0xffff; + $parent = 0xffff; printf "qdisc add dev %s handle %x: ingress\n", $dev, $parent; # find largest class id (to use for default) my $maxid = 0; foreach my $class (@$classes) { - my $id = $class->{id}; - $maxid = $id if ($id > $maxid); + my $id = $class->{id}; + $maxid = $id if ( $id > $maxid ); } foreach my $class (@$classes) { foreach my $match ( $class->matchRules() ) { - my $id = $class->{id}; - $id = $maxid + 1 if ($id == 0); + my $id = $class->{id}; + $id = $maxid + 1 if ( $id == 0 ); - my $police = " police rate " . $class->{rate} - . " action drop burst " . $class->{burst}; + my $police = + " police rate " + . $class->{rate} + . " action drop burst " + . $class->{burst}; - $match->filter( $dev, $parent, $id, $class->{priority}, - undef, $police ); + $match->filter( $dev, $parent, $id, $class->{priority}, undef, + $police ); } } - + } 1; diff --git a/lib/Vyatta/Qos/TrafficShaper.pm b/lib/Vyatta/Qos/TrafficShaper.pm index 4fa3008..4d43c4e 100644 --- a/lib/Vyatta/Qos/TrafficShaper.pm +++ b/lib/Vyatta/Qos/TrafficShaper.pm @@ -68,18 +68,18 @@ sub _getClasses { # Check constraints on class bandwidth values sub _checkClasses { - my $level = shift; - my $rate = shift; + my $level = shift; + my $rate = shift; my $default = shift; - + # if auto, can't check for constraints until later - $rate = ( $rate eq "auto") ? undef : getRate($rate); + $rate = ( $rate eq "auto" ) ? undef : getRate($rate); die "Bandwidth not defined for default traffic\n" - unless $default->{_rate}; + unless $default->{_rate}; $default->rateCheck( $rate, "$level default" ) if $rate; foreach my $class (@_) { - die "$class->{level} bandwidth not defined\n" unless $class->{_rate}; + die "$class->{level} bandwidth not defined\n" unless $class->{_rate}; $class->rateCheck( $rate, "$level class $class->{id}" ) if $rate; } } @@ -151,10 +151,10 @@ sub commands { $class->gen_class( $dev, 'htb', $parent, $rate ); $class->gen_leaf( $dev, $parent, $rate ); - my $prio = 1; + my $prio = 1; foreach my $match ( $class->matchRules() ) { - $match->filter( $dev, $parent, $class->{id}, - $prio++, $class->{dsmark} ); + $match->filter( $dev, $parent, $class->{id}, $prio++, + $class->{dsmark} ); } } } diff --git a/lib/Vyatta/Qos/Util.pm b/lib/Vyatta/Qos/Util.pm index 8649a72..7c7758d 100644 --- a/lib/Vyatta/Qos/Util.pm +++ b/lib/Vyatta/Qos/Util.pm @@ -79,8 +79,7 @@ sub getAutoRate { "Interface $dev speed cannot be determined (assuming 10mbit)\n"; $rate = 10000000; } - } - else { + } else { $rate = getRate($rate); } @@ -106,8 +105,7 @@ sub getRate { } die "$rate is not a valid bandwidth (unknown scale suffix)\n"; - } - else { + } else { # No suffix implies Kbps just as IOS return $num * 1000; @@ -118,16 +116,16 @@ sub getPercent { my $percent = shift; my ( $num, $suffix ) = get_num($percent); - if (defined $suffix && $suffix ne '%' ) { - die "$percent incorrect suffix (expect %)\n"; - } elsif (! defined $num) { - die "$percent is not a valid percent (not a number)\n"; + if ( defined $suffix && $suffix ne '%' ) { + die "$percent incorrect suffix (expect %)\n"; + } elsif ( !defined $num ) { + die "$percent is not a valid percent (not a number)\n"; } elsif ( $num < 0 ) { - die "$percent is not a acceptable percent (negative value)\n"; + die "$percent is not a acceptable percent (negative value)\n"; } elsif ( $num > 100 ) { - die "$percent is not a acceptable percent (greater than 100%)\n"; + die "$percent is not a acceptable percent (greater than 100%)\n"; } else { - return $num; + return $num; } } @@ -153,20 +151,13 @@ sub getTime { ( $num >= 0 ) or die "$time is not a valid time interval (negative value)\n"; - if ( defined $suffix ) { - my $scale = $timeunits{ lc $suffix }; + return $num * 1000 unless $suffix; # No suffix implies ms - if ( defined $scale ) { - return $num * $scale; - } + my $scale = $timeunits{ lc $suffix }; + die "$time is not a valid time interval (unknown suffix)\n" + unless $scale; - die "$time is not a valid time interval (unknown suffix)\n"; - } - else { - - # No suffix implies ms - return $num * 1000; - } + return $num * $scale; } my %scales = ( @@ -191,14 +182,13 @@ sub getBurstSize { ( $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 unless $suffix; + + my $scale = $scales{ lc $suffix }; + defined $scale + or die "$size is not a valid burst size (unknown scale suffix)\n"; - return $num; + return $num * $scale; } sub getProtocol { @@ -214,9 +204,9 @@ sub getProtocol { my ( $name, $aliases, $proto ) = getprotobyname($str); die "\"$str\" unknown protocol\n" - unless $proto; + unless $proto; die "$name is not usable as an IP protocol match\n" - if ($proto == 0); + if ( $proto == 0 ); return $proto; } -- cgit v1.2.3