diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/show-input-policy.pl | 184 |
1 files changed, 184 insertions, 0 deletions
diff --git a/scripts/show-input-policy.pl b/scripts/show-input-policy.pl new file mode 100644 index 0000000..41ea209 --- /dev/null +++ b/scripts/show-input-policy.pl @@ -0,0 +1,184 @@ +#!/usr/bin/perl +# +# Module: show-input-policy.pl +# +# **** 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) 2007 Vyatta, Inc. +# All Rights Reserved. +# +# Author: Stephen Hemminger +# Date: July 2008 +# Description: Script to display QoS information in pretty form +# +# **** End License **** +# + +use strict; +use warnings; + +use Getopt::Long; + +use lib "/opt/vyatta/share/perl5/"; +use Vyatta::Interface; +use Vyatta::Misc; + +my $INGRESS = 0xffff; + +sub ingress_interface { + my @interfaces; + + # Read base qdisc list to find ingress + open( my $tc, '-|', '/sbin/tc qdisc ls' ) + or die 'tc qdisc command failed'; + + while (<$tc>) { + chomp; + # qdisc ingress ffff: dev eth0 parent ffff:fff1 ------------------- + my (undef, $qdisc, undef, undef, $dev) = split; + next unless ($qdisc eq 'ingress'); + push @interfaces, $dev; + } + close $tc; + + return @interfaces; +} + +sub qminor { + my $id = shift; + + return hex($1) if ( $id =~ /:(.*)$/ ); +} + +sub get_filter { + my ($interface) = @_; + + open( my $tc, '-|', + "/sbin/tc -s -s filter show dev $interface parent ffff:" ) + or die 'tc filter command failed: $!'; + + my $id = $INGRESS; + my ($rate, $policy); + my %filters; + + while (<$tc>) { + chomp; + /^filter/ && do { + # filter protocol all pref 20 u32 + # filter protocol all pref 20 u32 fh 800: ht divisor 1 + # filter protocol all pref 20 u32 fh 800::800 order 2048 ... flowid ffff:2 + my @field = split; + next unless $#field >= 16 && $field[15] eq 'flowid'; + $id = qminor($field[16]); + }; + /^\s+police/ && do { + # police 0x3 rate 80000Kbit burst 16Kb + (undef, undef, undef, $rate) = split; + $rate =~ s/bit$//; + $policy = 'limit'; + }; + /^\s+action/ && do { + # action order 1: mirred (Egress Redirect to device ifb0) stolen + my (undef, undef, undef, undef, undef, $action) = split; + $policy = lc($action); + }; + /^\s+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/\)$//; + + $filters{$id} = [ $policy, $sent, $drop, $over, $rate, ]; + $id = $INGRESS; + $policy = undef; + $rate = undef; + }; + } + + return \%filters; +} + +sub show { + my $interface = shift; + my $filters = get_filter($interface); + return unless $filters; + + print "\n$interface input:\n"; + + my $fmt = "%-10s %-10s %-10s %-9s %-9s %s\n"; + printf $fmt, 'Class', 'Policy', 'Received', 'Dropped', 'Overlimit', 'Rate'; + + foreach my $id (sort keys %{$filters}) { + my @args = @{$filters->{$id}}; + my $class = ($id eq $INGRESS) ? 'default' : $id; + my $rate = pop @args; + $rate = '-' unless defined($rate); + + printf $fmt, $class, @args, $rate; + } +} + +sub show_brief { + my @interfaces = ingress_interface(); + + my $fmt = "%-10s %-10s %-10s %-9s %-9s\n"; + printf $fmt, 'Interface', 'Policy', 'Received', 'Dropped', 'Overlimit'; + + foreach my $intf (sort @interfaces) { + my $filters = get_filter($intf); + my $policy; + my $receive = 0; + my $dropped = 0; + my $overlimit = 0; + + foreach my $id (keys %{$filters}) { + my @args = @{$filters->{$id}}; + $policy = $args[0]; + $receive += $args[1]; + $dropped += $args[2]; + $overlimit += $args[3]; + } + printf $fmt, $intf, $policy, $receive, $dropped, $overlimit; + } + exit 0; +} + +sub usage { + print "Usage: $0 [--type={ethernet,serial}] --brief\n"; + print " $0 interface(s)\n"; + exit 1; +} + +my ($intf_type, $brief); + +GetOptions( + 'type=s' => \$intf_type, + 'brief' => \$brief, +) or usage(); + +show_brief() if $brief; + +if ( $#ARGV == -1 ) { + foreach my $ifname ( getInterfaces() ) { + if ($intf_type) { + my $intf = new Vyatta::Interface($ifname); + next unless ( $intf && $intf_type eq $intf->type() ); + } + push @ARGV, $ifname; + } +} + +foreach my $interface ( sort @ARGV ) { + show($interface); +} |