diff options
| -rwxr-xr-x | scripts/vyatta-show-queueing.pl | 271 |
1 files changed, 148 insertions, 123 deletions
diff --git a/scripts/vyatta-show-queueing.pl b/scripts/vyatta-show-queueing.pl index 5ab66c0..9d6caa6 100755 --- a/scripts/vyatta-show-queueing.pl +++ b/scripts/vyatta-show-queueing.pl @@ -119,110 +119,92 @@ sub byclassid { 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($a1) <=> hex($b1); + if ($a1 eq $b1) { + return hex($a2) <=> hex($b2); + } else { + return hex($a1) <=> hex($b1); + } } +# Recursively add classes to parent tree sub class2tree { - my ( $classes, $parentid, $parent ) = @_; + my ( $classes, $parent_id, $parent_tree ) = @_; foreach my $id ( sort byclassid keys %{$classes} ) { my $class = $classes->{$id}; - next unless ( $class->{parent} && $class->{parent} eq $parentid ); - my $node = Tree::Simple->new( $class->{info} ); - $parent->addChild($node); + next unless ( $class->{parent} && $class->{parent} eq $parent_id ); + + my $node = Tree::Simple->new( $class ); + $parent_tree->addChild($node); + class2tree( $classes, $id, $node ); } - - return $parent; } # Build a tree of output information # (This is N^2 but not a big issue) sub get_class { - my ( $interface, $rootq, $qdisc ) = @_; + my ( $interface, $rootq ) = @_; my %classes; open( my $tc, '-|', "/sbin/tc -s class show dev $interface" ) or die 'tc class command failed: $!'; - my ( $id, $name, $sent, $drop, $over, $root, $leaf, $parent ); - + my ($id, $info, $root); 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: - 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'"; + /^class \S+ (\S+) / && 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: + + # record last data, and clean slate + $classes{$id} = $info if $id; + + $info = {}; + $id = $1; + $info->{id} = $id; + + if (/ root / ) { + $root = $id; + } else { + / parent (\S+)/ && do { + $info->{parent} = $1; + }; + + / leaf ([0-9a-f]+):/ && do { + $info->{leaf} = hex($1); + }; } next; }; - /^ Sent/ && do { - - # Sent 13860 bytes 88 pkt (dropped 0, overlimits 0 requeues 0) - ( undef, $sent, undef, undef, undef, undef, $drop, undef, $over ) = - split; + /^ Sent (\d+) bytes (\d+) pkt/ && do { + $info->{sent} = $1; + }; - # fix silly punctuation bug in tc - $drop =~ s/,$//; - next; + / \(dropped (\d+), overlimits (\d+) requeues (\d+)\) / && do { + $info->{dropped} = $1; + $info->{overlimit} = $2; + $info->{requeues} = $3; }; - /^ rate/ && do { - - # rate 0bit 0pps backlog 0b 23p requeues 0 - my ( undef, $rate, undef, undef, undef, $backlog ) = split; - $backlog =~ s/p$//; - $rate =~ s/bit$//; + / rate (\S+)bit (\d+)pps / && do { + $info->{rate} = $1; + $info->{pps} = $2; + }; - # 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 ); - - # 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 { - push @args, shaper($name), $sent, $drop, $over, $rate, $backlog; - } - - $classes{$id} = { - id => $id, - parent => $parent, - info => \@args, - }; - - $root = $classes{$id} unless $parent; - next; - } + / backlog \d+b (\d+)p / && do { + $info->{backlog} = $1; + }; } close $tc; + $classes{$id} = $info if $id; return unless $root; - return class2tree( \%classes, $root->{id}, - Tree::Simple->new( $root->{info}, Tree::Simple->ROOT ) ); + my $tree = Tree::Simple->new( $classes{$root}, Tree::Simple->ROOT ); + class2tree( \%classes, $root, $tree ); + return $tree; } sub qmajor { @@ -232,91 +214,134 @@ sub qmajor { return hex($id); } +sub qminor { + my $id = shift; + + $id =~ s/^.*://; + return hex($id); +} + # 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 @qdisc; my ( $root, $dsmark ); open( my $tc, '-|', "/sbin/tc -s qdisc show dev $interface" ) or die 'tc command failed: $!'; - my ( $qid, $name, $sent, $drop, $over ); + my ($qid, $qinfo); + while (<$tc>) { chomp; - /^qdisc/ && do { - - # qdisc htb 1: root r2q 10 default 20 direct_packets... - my ( $t, $pqid ); - - ( undef, $name, $qid, $t, $pqid ) = split; - $qid = qmajor($qid); - if ( $name eq 'dsmark' ) { - $dsmark = $qid; + # qdisc htb 1: root r2q 10 default 20 direct_packets... + # qdisc pfifo 8008: parent 1:2 limit 1000p + /^qdisc (\S+) ([0-9a-f]+): / && do { + # record last qdisc + $qdisc[$qid] = $qinfo if ($qid); + $qinfo = {}; + + my $name = $1; + $qid = hex($2); + + $qinfo->{name} = shaper($name); + $dsmark = $qid if ($name eq 'dsmark'); + + if (/ root /) { + $root = $qid; + } elsif ( / parent (\S+)/ ) { + my $pqid = $1; + + # hide dsmark qdisc from display + if (defined($dsmark) && qmajor($pqid) == $dsmark) { + $root = $qid; + } else { + $qinfo->{parent} = $pqid; + } } - 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; + if (/ default ([0-9a-f]+) / ) { + $qinfo->{default} = hex($1); + } - # fix silly punctuation bug in tc - $drop =~ s/,$//; next; }; - /^ rate/ && do { + /^ Sent (\d+) bytes (\d+) pkt/ && do { + $qinfo->{sent} = $1; + }; - # rate 0bit 0pps backlog 0b 23p requeues 0 - my ( undef, $rate, undef, undef, undef, $backlog ) = split; + / \(dropped (\d+), overlimits (\d+) requeues (\d+)\) / && do { + $qinfo->{dropped} = $1; + $qinfo->{overlimit} = $2; + $qinfo->{requeues} = $3; + }; - $backlog =~ s/p$//; - $rate =~ s/bit$//; + / rate (\S+)bit (\d+)pps / && do { + $qinfo->{rate} = $1; + $qinfo->{pps} = $2; + }; - $qdisc{$qid} = - [ shaper($name), $sent, $drop, $over, $rate, $backlog ]; - } + / backlog \d+b (\d+)p / && do { + $qinfo->{backlog} = $1; + } } close $tc; + $qdisc[$qid] = $qinfo if $qid; + + return ( $root, \@qdisc ); +} + +my $CLASSFMT = "%-10s %-16s"; +my @fields = qw(sent rate dropped overlimit backlog); + +sub print_info { + my ($id, $name, $info, $depth) = @_; + my $indent = ' ' x $depth; - return ( $root, \%qdisc ); + # Class Policy + printf $CLASSFMT, $indent . $id, $name; + + for (@fields) { + my $val = $info->{$_}; + if (defined($val)) { + printf " %8d", $val; + } else { + print ' '; + } + } + print "\n"; } sub show_queues { - my ( $interface, $root, $qdisc ) = @_; - my $args = $qdisc->{$root}; - return unless $args; + my ( $interface, $qdisc, $root ) = @_; + my $rootq = $qdisc->[$root]; + my $default = $rootq->{default}; - 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 $CLASSFMT, 'Class', 'Policy'; + for (@fields) { + printf " %8s", ucfirst($_); + } + print "\n"; - printf $fmt, 'root', @{$args}; + print_info('root', $rootq->{name}, $rootq, 0); - my $tree = get_class( $interface, $root, $qdisc ); + my $tree = get_class( $interface, $root ); return unless $tree; $tree->traverse( sub { - my $_tree = shift; - my @args = @{ $_tree->getNodeValue() }; - my $id = shift @args; - printf $fmt, ( ' ' x $_tree->getDepth() . $id ), @args; + my $node = shift; + my $class = $node->getNodeValue(); + my $qid = qminor($class->{id}); + $qid = 'default' if (defined($default) && $qid == $default); + + my $subq = $qdisc->[$class->{leaf}]; + + print_info($qid, $subq->{name}, $class, $node->getDepth()); } ); } @@ -328,7 +353,7 @@ sub show { # Show output queue first ( $root, $qdisc ) = get_qdisc($interface) unless $root; - show_queues( $interface, $root, $qdisc ) if $root; + show_queues( $interface, $qdisc, $root ) if $root; } sub usage { |