summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xscripts/vyatta-show-queueing.pl253
1 files changed, 64 insertions, 189 deletions
diff --git a/scripts/vyatta-show-queueing.pl b/scripts/vyatta-show-queueing.pl
index 9d86579..5b967ec 100755
--- a/scripts/vyatta-show-queueing.pl
+++ b/scripts/vyatta-show-queueing.pl
@@ -37,6 +37,7 @@ my $intf_type;
# Map from kernel qdisc names to configuration names
my %qdisc_types = (
'pfifo_fast' => 'default',
+ 'fq_codel' => 'fq-codel',
'sfq' => 'fair-queue',
'tbf' => 'rate-control',
'htb' => 'shaper',
@@ -46,8 +47,7 @@ my %qdisc_types = (
'prio' => 'priority-queue',
'netem' => 'network-emulator',
'gred' => 'weighted-random',
- 'prio' => 'priority-queue',
- 'ingress' => 'limiter',
+ 'ingress' => 'limiter',
);
# Convert from kernel to vyatta nams
@@ -59,7 +59,7 @@ sub shaper {
}
sub show_brief {
- my $fmt = "%-10s %-16s %10s %10s %10s\n";
+ my $fmt = "%-10s %-16s %12s %12s %12s\n";
printf $fmt, 'Interface', 'Policy', 'Sent', 'Dropped', 'Overlimit';
# Read qdisc info
@@ -114,106 +114,6 @@ sub show_brief {
print sort @lines;
}
-# 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]+)/ );
-
- # Gracefully handle 'X:' classes
- if(!defined $a1) { $a1 = '0'; }
- if(!defined $a2) { $a2 = '0'; }
- if(!defined $b1) { $b1 = '0'; }
- if(!defined $b2) { $b2 = '0'; }
-
- 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, $parent_id, $parent_tree ) = @_;
-
- foreach my $id ( sort byclassid keys %{$classes} ) {
- my $class = $classes->{$id};
- next unless ( $class->{parent} && $class->{parent} eq $parent_id );
-
- my $node = Tree::Simple->new( $class );
- $parent_tree->addChild($node);
-
- class2tree( $classes, $id, $node );
- }
-}
-
-# Build a tree of output information
-# (This is N^2 but not a big issue)
-sub get_class {
- my ( $interface, $rootq ) = @_;
- my %classes;
-
- open( my $tc, '-|', "/sbin/tc -s class show dev $interface" )
- or die 'tc class command failed: $!';
-
- my ($id, $info, $root);
- while (<$tc>) {
- chomp;
- /^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 (\d+) bytes (\d+) pkt/ && do {
- $info->{sent} = $1;
- };
-
- / \(dropped (\d+), overlimits (\d+) requeues (\d+)\) / && do {
- $info->{dropped} = $1;
- $info->{overlimit} = $2;
- $info->{requeues} = $3;
- };
-
- / rate (\S+)bit (\d+)pps / && do {
- $info->{rate} = $1;
- $info->{pps} = $2;
- };
-
- / backlog \d+b (\d+)p / && do {
- $info->{backlog} = $1;
- };
- }
- close $tc;
- $classes{$id} = $info if $id;
- return unless $root;
-
- my $tree = Tree::Simple->new( $classes{$root}, Tree::Simple->ROOT );
- class2tree( \%classes, $root, $tree );
- return $tree;
-}
-
sub qmajor {
my $id = shift;
@@ -229,11 +129,11 @@ sub qminor {
}
# This collects all the qdisc information into one hash
-# and root queue id and reference to map of qdisc to statistics
+# reference to map of qdisc class to statistics
sub get_qdisc {
my $interface = shift;
- my @qdisc;
- my ( $root, $dsmark );
+ my %qdisc;
+ my $default = undef;
open( my $tc, '-|', "/sbin/tc -s qdisc show dev $interface" )
or die 'tc command failed: $!';
@@ -243,127 +143,102 @@ sub get_qdisc {
while (<$tc>) {
chomp;
- # qdisc htb 1: root r2q 10 default 20 direct_packets...
- # qdisc pfifo 8008: parent 1:2 limit 1000p
+ # qdisc htb 1: root r2q 10 default 20 direct_packets...
+ # qdisc pfifo 8008: parent 1:2 limit 1000p
+ # qdisc fq_codel 8001: root refcnt 2 limit 10240p flows 1024 quantum 1514 target 5.0ms interval 100.0ms
/^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;
- }
- }
-
- if (/ default ([0-9a-f]+) / ) {
- $qinfo->{default} = hex($1);
- }
+ # record last qdisc
+ $qdisc{$qid} = $qinfo if (defined($qid));
+ $qinfo = {};
+ $qid = 0;
+ $qinfo->{name} = shaper($1);
+
+ if (/ root /) {
+ $qinfo->{qidname} = 'root';
+ } elsif ( / parent (\S+)/ ) {
+ my $parent = qminor($1);
+ $qid = $parent;
+ if (defined($default) && ($parent == $default)) {
+ $qinfo->{qidname} = 'default';
+ } else {
+ $qinfo->{qidname} = qminor($1);
+ }
+ };
+
+ if (/ default ([0-9a-f]+) / ) {
+ $default = hex($1);
+ };
next;
};
/^ Sent (\d+) bytes (\d+) pkt/ && do {
- $qinfo->{sent} = $1;
- };
+ $qinfo->{sent} = $1;
+ };
- / \(dropped (\d+), overlimits (\d+) requeues (\d+)\) / && do {
- $qinfo->{dropped} = $1;
- $qinfo->{overlimit} = $2;
- $qinfo->{requeues} = $3;
+ / \(dropped (\d+), overlimits (\d+) requeues (\d+)\) / && do {
+ $qinfo->{dropped} = $1;
+ $qinfo->{overlimit} = $2;
+ $qinfo->{requeues} = $3;
};
- / rate (\S+)bit (\d+)pps / && do {
- $qinfo->{rate} = $1;
- $qinfo->{pps} = $2;
- };
+ / rate (\S+)bit (\d+)pps / && do {
+ $qinfo->{rate} = $1;
+ $qinfo->{pps} = $2;
+ };
- / backlog \d+b (\d+)p / && do {
- $qinfo->{backlog} = $1;
- }
+ / backlog \d+b (\d+)p / && do {
+ $qinfo->{backlog} = $1;
+ }
}
close $tc;
- $qdisc[$qid] = $qinfo if $qid;
+ $qdisc{$qid} = $qinfo if (defined($qid));
- return ( $root, \@qdisc );
+ return \%qdisc;
}
my $CLASSFMT = "%-10s %-16s";
-my @fields = qw(sent rate dropped overlimit backlog);
+my @fields = qw(sent dropped overlimit backlog);
sub print_info {
- my ($id, $name, $info, $depth) = @_;
- my $indent = ' ' x $depth;
+ my $qinfo = shift;
+ my $id = $qinfo->{qidname};
+ my $name = $qinfo->{name};
# Class Policy
- printf $CLASSFMT, $indent . $id, $name;
+ printf $CLASSFMT, $id, $name;
for (@fields) {
- my $val = $info->{$_};
- if (defined($val)) {
- printf ' %8s', $val;
- } else {
- print ' ';
- }
+ my $qval = $qinfo->{$_};
+ if (defined($qval)) {
+ printf ' %12s', $qval;
+ } else {
+ print ' ';
+ }
}
print "\n";
}
sub show_queues {
- my ( $interface, $qdisc, $root ) = @_;
- my $rootq = $qdisc->[$root];
- my $default = $rootq->{default};
+ my ( $interface, $qdisc ) = @_;
print "\n$interface Queueing:\n";
printf $CLASSFMT, 'Class', 'Policy';
for (@fields) {
- printf " %8s", ucfirst($_);
+ printf " %12s", ucfirst($_);
}
print "\n";
- print_info('root', $rootq->{name}, $rootq, 0);
-
- my $tree = get_class( $interface, $root );
- return unless $tree;
-
- $tree->traverse(
- sub {
- my $node = shift;
- my $class = $node->getNodeValue();
- my $qid = qminor($class->{id});
- $qid = 'default' if (defined($default) && $qid == $default);
-
- # Return if said class has no leaf queue
- return unless defined($class->{leaf}) && defined($qdisc->[$class->{leaf}]);
-
- my $subq = $qdisc->[$class->{leaf}];
-
- print_info($qid, $subq->{name}, $class, $node->getDepth());
- }
- );
+ foreach my $qid ( sort {$a <=> $b} keys %{$qdisc} ) {
+ my $qinfo = $qdisc->{$qid};
+ print_info($qinfo);
+ }
}
sub show {
my $interface = shift;
- my ( $root, $qdisc );
-
- # Show output queue first
- ( $root, $qdisc ) = get_qdisc($interface) unless $root;
-
- show_queues( $interface, $qdisc, $root ) if $root;
+ my $qdisc = get_qdisc($interface);
+ show_queues($interface, $qdisc);
}
sub usage {