1 files changed, 302 insertions, 0 deletions
diff --git a/lib/Vyatta/Qos/Util.pm b/lib/Vyatta/Qos/Util.pm
new file mode 100644
index 0000000..28df9f1
--- /dev/null
+++ b/lib/Vyatta/Qos/Util.pm
@@ -0,0 +1,302 @@
+# Wrappers for iproute2 utilities
+#
+# **** 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) 2008 Vyatta, Inc.
+# All Rights Reserved.
+# **** End License ****
+
+package Vyatta::Qos::Util;
+our @EXPORT = qw(getRate getPercent getBurstSize getProtocol getDsfield getTime);
+our @EXPORT_OK = qw(interfaceRate getIfIndex);
+use base qw(Exporter);
+
+use strict;
+use warnings;
+
+sub get_num {
+    use POSIX qw(strtod);
+    my ($str) = @_;
+    $str =~ s/^\s+//;
+    $str =~ s/\s+$//;
+
+    $! = 0;
+    my ( $num, $unparsed ) = strtod($str);
+    if ( ( $unparsed == length($str) ) || $! ) {
+        return;    # undefined (bad input)
+    }
+
+    if ( $unparsed > 0 ) { return $num, substr( $str, -$unparsed ); }
+    else                 { return $num; }
+}
+
+## get_rate("10mbit")
+# convert rate specification to number
+# from tc/tc_util.c
+
+my %rates = (
+    'bit'   => 1,
+    'kibit' => 1024,
+    'kbit'  => 1000.,
+    'mibit' => 1048576.,
+    'mbit'  => 1000000.,
+    'gibit' => 1073741824.,
+    'gbit'  => 1000000000.,
+    'tibit' => 1099511627776.,
+    'tbit'  => 1000000000000.,
+    'bps'   => 8.,
+    'kibps' => 8192.,
+    'kbps'  => 8000.,
+    'mibps' => 8388608.,
+    'mbps'  => 8000000.,
+    'gibps' => 8589934592.,
+    'gbps'  => 8000000000.,
+    'tibps' => 8796093022208.,
+    'tbps'  => 8000000000000.,
+);
+
+sub getRate {
+    my $rate = shift;
+    my ( $num, $suffix ) = get_num($rate);
+
+    defined $num
+      or die "$rate is not a valid bandwidth (not a number)\n";
+    ( $num >= 0 )
+      or die "$rate is not a valid bandwidth (negative value)\n";
+
+    if ( defined $suffix ) {
+        my $scale = $rates{ lc $suffix };
+
+        if ( defined $scale ) {
+            return $num * $scale;
+        }
+
+        die "$rate is not a valid bandwidth (unknown scale suffix)\n";
+    }
+    else {
+
+        # No suffix implies Kbps just as IOS
+        return $num * 1000;
+    }
+}
+
+sub getPercent {
+    my $percent = shift;
+    my ( $num, $suffix ) = get_num($percent);
+
+    ( $suffix eq '%' )
+      or die "$percent incorrect suffix (expect %)\n";
+    defined $num
+      or die "$percent is not a valid percent bandwidth (not a number)\n";
+    ( $num >= 0 )
+      or die
+      "$percent is not a acceptable percent bandwidth (negative value)\n";
+    ( $num <= 100 )
+      or die
+      "$percent is not a acceptable percent bandwidth (greater than 100%)\n";
+
+    return $num;
+}
+
+# Default time units for tc are usec.
+my %timeunits = (
+    's'     => 1000000,
+    'sec'   => 1000000,
+    'secs'  => 1000000,
+    'ms'    => 1000,
+    'msec'  => 1000,
+    'msecs' => 1000,
+    'us'    => 1,
+    'usec'  => 1,
+    'usecs' => 1,
+);
+
+sub getTime {
+    my $time = shift;
+    my ( $num, $suffix ) = get_num($time);
+
+    defined $num
+      or die "$time is not a valid time interval (not a number)\n";
+    ( $num >= 0 )
+      or die "$time is not a valid time interval (negative value)\n";
+
+    if ( defined $suffix ) {
+        my $scale = $timeunits{ lc $suffix };
+
+        if ( defined $scale ) {
+            return $num * $scale;
+        }
+
+        die "$time is not a valid time interval (unknown suffix)\n";
+    }
+    else {
+
+        # No suffix implies ms
+        return $num * 1000;
+    }
+}
+
+my %scales = (
+    'b'    => 1,
+    'k'    => 1024,
+    'kb'   => 1024,
+    'kbit' => 1024 / 8,
+    'm'    => 1024 * 1024,
+    'mb'   => 1024 * 1024,
+    'mbit' => 1024 * 1024 / 8,
+    'g'    => 1024 * 1024 * 1024,
+    'gb'   => 1024 * 1024 * 1024,
+);
+
+sub getBurstSize {
+    my $size = shift;
+    my ( $num, $suffix ) = get_num($size);
+
+    defined $num
+      or die "$size is not a valid burst size (not a number)\n";
+
+    ( $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;
+}
+
+sub getProtocol {
+    my ($str) = @_;
+
+    defined $str or return;
+    if ( $str =~ /^([0-9]+)|(0x[0-9a-fA-F]+)$/ ) {
+        if ( $str < 0 || $str > 255 ) {
+            die "$str is not a valid protocol number\n";
+        }
+        return $str;
+    }
+
+    my ( $name, $aliases, $proto ) = getprotobyname($str);
+    ( defined $proto ) or die "\"$str\" unknown protocol\n";
+    return $proto;
+}
+
+# Parse /etc/iproute/rt_dsfield
+# return a hex string "0x10" or undefined
+sub getDsfield {
+    my ($str)      = @_;
+    my $match      = undef;
+    my $dsFileName = '/etc/iproute2/rt_dsfield';
+
+    defined $str or return;
+
+    # match number (or hex)
+    if ( $str =~ /^([0-9]+)|(0x[0-9a-fA-F]+)$/ ) {
+        if ( $str < 0 || $str > 63 ) {
+            die "$str is not a valid DSCP value\n";
+        }
+
+        # convert DSCP value to header value used by iproute
+        return $str << 2;
+    }
+
+    open my $ds, '<', $dsFileName || die "Can't open $dsFileName, $!\n";
+    while (<$ds>) {
+        next if /^#/;
+        chomp;
+        my ( $value, $name ) = split;
+        if ( $str eq $name ) {
+            $match = $value;
+            last;
+        }
+    }
+    close($ds) or die "read $dsFileName error\n";
+
+    ( defined $match ) or die "\"$str\" unknown DSCP value\n";
+    return $match;
+}
+
+sub getIfIndex {
+    my ($str) = @_;
+
+    defined $str or return;
+    open my $sysfs, "<",
+      "/sys/class/net/$str/ifindex" || die "Unknown interface $str\n";
+    my $ifindex = <$sysfs>;
+    close($sysfs) or die "read sysfs error\n";
+    chomp $ifindex;
+    return $ifindex;
+}
+
+## interfaceRate("eth0")
+# return result in bits per second
+sub interfaceRate {
+    my ($interface) = @_;
+    my $speed;
+    my $config = new VyattaConfig;
+
+    $config->setLevel("interfaces ethernet");
+    if ( $config->exists("$interface") ) {
+        $speed = $config->returnValue("$interface speed");
+        if ( defined($speed) && $speed ne "auto" ) {
+            return $speed * 1000000;
+        }
+    }
+
+    # During boot it may take time for auto-negotiation
+    for ( my $retries = 0 ; $retries < 5 ; $retries++ ) {
+        $speed = ethtoolRate($interface);
+        if ( defined $speed ) {
+            last;
+        }
+        sleep 1;
+    }
+
+    return $speed;
+}
+
+## ethtoolRate("eth0")
+# Fetch actual rate using ethtool and format to valid tc rate
+sub ethtoolRate {
+    my $dev  = shift;
+    my $rate = undef;
+
+    # Get rate of real device (ignore vlan)
+    $dev =~ s/\.[0-9]+$//;
+
+    open( my $ethtool, "/usr/sbin/ethtool $dev 2>/dev/null |" )
+      or die "ethtool failed: $!\n";
+
+    # ethtool produces:
+    #
+    # Settings for eth1:
+    # Supported ports: [ TP ]
+    # ...
+    # Speed: 1000Mb/s
+    while (<$ethtool>) {
+        my @line = split;
+        if ( $line[0] =~ /^Speed:/ ) {
+            if ( $line[1] =~ /[0-9]+Mb\/s/ ) {
+                $rate = $line[1];
+                $rate =~ s#Mb/s#000000#;
+            }
+            last;
+        }
+    }
+    close $ethtool;
+    return $rate;
+}
+
+1;