From 3381f37aa69de5af6090401b7c57cbc45a07b569 Mon Sep 17 00:00:00 2001 From: Stephen Hemminger Date: Thu, 15 Apr 2010 10:19:39 -0700 Subject: Change queuing script to corespond to input interface changes No longer display ingress in this command; will be done by new command. Also reindent script. --- scripts/vyatta-show-queueing.pl | 192 ++++++++++++++++++---------------------- 1 file changed, 84 insertions(+), 108 deletions(-) diff --git a/scripts/vyatta-show-queueing.pl b/scripts/vyatta-show-queueing.pl index 6308c8f..e39a61a 100755 --- a/scripts/vyatta-show-queueing.pl +++ b/scripts/vyatta-show-queueing.pl @@ -13,11 +13,10 @@ # General Public License for more details. # # This code was originally developed by Vyatta, Inc. -# Portions created by Vyatta are Copyright (C) 2007 Vyatta, Inc. +# Copyright (C) 2010 Vyatta, Inc. # All Rights Reserved. # # Author: Stephen Hemminger -# Date: July 2008 # Description: Script to display QoS information in pretty form # # **** End License **** @@ -47,7 +46,7 @@ my %qdisc_types = ( 'drr' => 'round-robin', 'prio' => 'priority-queue', 'netem' => 'network-emulator', - 'gred' => 'weighted-random', + 'gred' => 'weighted-random', ); # Convert from kernel to vyatta nams @@ -67,7 +66,7 @@ sub show_brief { # Read qdisc info open( my $tc, '-|', '/sbin/tc -s qdisc ls' ) - or die 'tc qdisc command failed'; + or die 'tc qdisc command failed'; my @lines; my ( $qdisc, $parent, $ifname, $id ); @@ -77,13 +76,14 @@ sub show_brief { chomp; my @fields = split; if ( $fields[0] eq 'qdisc' ) { - my ($ptype, $pid); - # Examples: + my ( $ptype, $pid ); + + # Examples: # qdisc sfq 8003: dev eth1 root limit 127p quantum 1514b - # qdisc gred 2: dev eth0 parent 1: + # qdisc gred 2: dev eth0 parent 1: ( undef, $qdisc, $id, undef, $ifname, $ptype, $pid ) = @fields; - $parent = ($ptype eq 'parent') ? $pid : $ptype; + $parent = ( $ptype eq 'parent' ) ? $pid : $ptype; next; } @@ -100,17 +100,21 @@ sub show_brief { if ( $id eq 'ffff:' ) { $ingress{$ifname} = [ $ifname, shaper($qdisc), $sent, $drop, $over ]; - } elsif ( $qdisc eq 'dsmark' ) { - # dsmark is used as a top-level before htb or gred - $root = $id; - } elsif ( $parent eq $root ) { - $root = 'root'; + } + elsif ( $qdisc eq 'dsmark' ) { + + # dsmark is used as a top-level before htb or gred + $root = $id; + } + elsif ( $parent eq $root ) { + $root = 'root'; if ($intf_type) { my $intf = new Vyatta::Interface($ifname); next unless ( $intf && ( $intf->type() eq $intf_type ) ); } - push @lines, sprintf $fmt, $ifname, shaper($qdisc), $sent, $drop, $over; + push @lines, sprintf $fmt, $ifname, shaper($qdisc), $sent, $drop, + $over; } } close $tc; @@ -130,10 +134,10 @@ sub show_brief { # Sort by class id which is a string of form major:minor # NB: numbers are hex sub byclassid { - my ($a1, $a2) = ($a =~ m/([0-9a-f]+):([0-9a-f]+)/); - my ($b1, $b2) = ($b =~ m/([0-9a-f]+):([0-9a-f]+)/); + my ( $a1, $a2 ) = ( $a =~ m/([0-9a-f]+):([0-9a-f]+)/ ); + my ( $b1, $b2 ) = ( $b =~ m/([0-9a-f]+):([0-9a-f]+)/ ); - return hex($a2) <=> hex($b2) if ($a1 == $b1); + return hex($a2) <=> hex($b2) if ( $a1 == $b1 ); return hex($a1) <=> hex($b1); } @@ -144,7 +148,7 @@ sub class2tree { my $class = $classes->{$id}; next unless ( $class->{parent} && $class->{parent} eq $parentid ); my $node = Tree::Simple->new( $class->{info} ); - $parent->addChild($node); + $parent->addChild($node); class2tree( $classes, $id, $node ); } @@ -165,26 +169,30 @@ sub get_class { while (<$tc>) { chomp; /^class/ && do { - # class htb 1:1 root rate 1000Kbit ceil 1000Kbit burst 1600b cburst 1600b - # class htb 1:2 parent 1:1 leaf 8001: - # class ieee80211 :2 parent 8001: + + # class htb 1:1 root rate 1000Kbit ceil 1000Kbit burst 1600b cburst 1600b + # class htb 1:2 parent 1:1 leaf 8001: + # class ieee80211 :2 parent 8001: my ( $l, $q, $t ); ( undef, $name, $id, $t, $parent, $l, $q ) = split; - $leaf = undef; - if ($t eq 'root') { - $parent = undef; - } elsif ($t eq 'parent') { - if ($l eq 'leaf') { - $q =~ s/:$//; - $leaf = hex($q); - } - } else { - die "confused by tc class output for type 'class $name $id $t'"; - } + $leaf = undef; + if ( $t eq 'root' ) { + $parent = undef; + } + elsif ( $t eq 'parent' ) { + if ( $l eq 'leaf' ) { + $q =~ s/:$//; + $leaf = hex($q); + } + } + else { + die "confused by tc class output for type 'class $name $id $t'"; + } next; }; /^ Sent/ && do { + # Sent 13860 bytes 88 pkt (dropped 0, overlimits 0 requeues 0) ( undef, $sent, undef, undef, undef, undef, $drop, undef, $over ) = split; @@ -195,24 +203,26 @@ sub get_class { }; /^ rate/ && do { + # rate 0bit 0pps backlog 0b 23p requeues 0 my ( undef, $rate, undef, undef, undef, $backlog ) = split; $backlog =~ s/p$//; $rate =~ s/bit$//; - # split $id of form 1:10 into parent, child id - my ($maj, $min) = ($id =~ m/([0-9a-f]+):([0-9a-f]+)/); + # split $id of form 1:10 into parent, child id + my ( $maj, $min ) = ( $id =~ m/([0-9a-f]+):([0-9a-f]+)/ ); - # TODO handle nested classes?? - next if (hex($maj) != $rootq); + # TODO handle nested classes?? + next if ( hex($maj) != $rootq ); - # record info for display + # record info for display my @args = ( hex($min) ); if ($leaf) { - my $qdisc_info = $qdisc->{$leaf}; - die "info for $leaf is unknown" unless $qdisc_info; - push @args, @{ $qdisc_info }; - } else { + my $qdisc_info = $qdisc->{$leaf}; + die "info for $leaf is unknown" unless $qdisc_info; + push @args, @{$qdisc_info}; + } + else { push @args, shaper($name), $sent, $drop, $over, $rate, $backlog; } @@ -240,49 +250,12 @@ sub qmajor { return hex($id); } - -sub get_filter { - my $interface = shift; - my %qdisc; - my ($root, $rate); - - open( my $tc, '-|', "/sbin/tc -s filter show dev $interface" ) - or die 'tc class command failed: $!'; - - while (<$tc>) { - chomp; - /^filter/ && do { - # filter parent 1: protocol all pref 20 u32 ... - my (undef, undef, $qid) = split; - $root = qmajor($qid); - }; - /^ police/ && do { - # police 0x3 rate 80000Kbit burst 16Kb - (undef, undef, undef, $rate) = split; - $rate =~ s/bit$//; - }; - /^ Sent/ && do { - # Sent 960 bytes 88 pkts (dropped 0, overlimits 0) - my ( undef, $sent, undef, undef, undef, undef, - $drop, undef, $over ) = split; - - $drop =~ s/,$//; - $over =~ s/)$//; - - $qdisc{$root} = [ 'traffic-limiter', $sent, $drop, $over, $rate, "" ]; - }; - } - return unless $rate; - - return ( $root, \%qdisc ); -} - # This collects all the qdisc information into one hash # and root queue id and reference to map of qdisc to statistics sub get_qdisc { my $interface = shift; my %qdisc; - my ($root, $dsmark); + my ( $root, $dsmark ); open( my $tc, '-|', "/sbin/tc -s qdisc show dev $interface" ) or die 'tc command failed: $!'; @@ -291,24 +264,30 @@ sub get_qdisc { while (<$tc>) { chomp; /^qdisc/ && do { + # qdisc htb 1: root r2q 10 default 20 direct_packets... - my ($t, $pqid); + my ( $t, $pqid ); ( undef, $name, $qid, $t, $pqid ) = split; - $qid = qmajor($qid); - - if ( $name eq 'dsmark' ) { - $dsmark = $qid; - } elsif ( $t eq 'parent' && defined($dsmark) - && qmajor($pqid) == $dsmark ) { - $root = $qid; - } elsif ( $t eq 'root' ) { - $root = $qid; - } + $qid = qmajor($qid); + + if ( $name eq 'dsmark' ) { + $dsmark = $qid; + } + elsif ($t eq 'parent' + && defined($dsmark) + && qmajor($pqid) == $dsmark ) + { + $root = $qid; + } + elsif ( $t eq 'root' ) { + $root = $qid; + } next; }; /^ Sent/ && do { + # Sent 13860 bytes 88 pkt (dropped 0, overlimits 0 requeues 0) ( undef, $sent, undef, undef, undef, undef, $drop, undef, $over ) = split; @@ -319,13 +298,15 @@ sub get_qdisc { }; /^ rate/ && do { + # rate 0bit 0pps backlog 0b 23p requeues 0 my ( undef, $rate, undef, undef, undef, $backlog ) = split; $backlog =~ s/p$//; $rate =~ s/bit$//; - $qdisc{$qid} = [ shaper($name), $sent, $drop, $over, $rate, $backlog ]; + $qdisc{$qid} = + [ shaper($name), $sent, $drop, $over, $rate, $backlog ]; } } close $tc; @@ -333,18 +314,14 @@ sub get_qdisc { return ( $root, \%qdisc ); } -my $INGRESS = 0xffff; - sub show_queues { my ( $interface, $root, $qdisc ) = @_; my $args = $qdisc->{$root}; return unless $args; - my $fmt = "%-10s %-16s %-10s %-9s %-9s %-9s %s\n"; - print "\n$interface ", ( ( $root eq $INGRESS ) ? 'Input' : 'Output' ), - " Queueing:\n"; - printf $fmt, 'Class', 'Qos-Policy', - ( ( $root eq $INGRESS ) ? 'Received' : 'Sent' ), + my $fmt = "%-10s %-16s %-10s %-9s %-9s %-9s %s\n"; + print "\n$interface Queueing:\n"; + printf $fmt, 'Class', 'Qos-Policy', 'Sent', 'Dropped', 'Overlimit', 'Rate', 'Queued'; printf $fmt, 'root', @{$args}; @@ -352,11 +329,14 @@ sub show_queues { my $tree = get_class( $interface, $root, $qdisc ); return unless $tree; - $tree->traverse( sub { my $_tree = shift; - my @args = @{ $_tree->getNodeValue() }; - my $id = shift @args; - printf $fmt, (' ' x $_tree->getDepth() . $id ), @args; - }); + $tree->traverse( + sub { + my $_tree = shift; + my @args = @{ $_tree->getNodeValue() }; + my $id = shift @args; + printf $fmt, ( ' ' x $_tree->getDepth() . $id ), @args; + } + ); } sub show { @@ -364,13 +344,9 @@ sub show { my ( $root, $qdisc ); # Show output queue first - ( $root, $qdisc ) = get_filter($interface); ( $root, $qdisc ) = get_qdisc($interface) unless $root; - show_queues( $interface, $root, $qdisc ) if $root; - - # TODO handle ifb - show_queues( $interface, $INGRESS, $qdisc ); + show_queues( $interface, $root, $qdisc ) if $root; } sub usage { -- cgit v1.2.3