Add initial support for SFB qdisc, still needs tuning

2 files changed, 191 insertions, 1 deletions

diff --git a/lib/Vyatta/Qos/FairBlue.pm b/lib/Vyatta/Qos/FairBlue.pm
new file mode 100644
index 0000000..57060f0
--- /dev/null
+++ b/lib/Vyatta/Qos/FairBlue.pm
@@ -0,0 +1,132 @@
+# Random Detect
+#
+# This Qos module uses DSMARK and GRED to provide a policy
+# similar to Cisco Weighted Random Detect.
+#
+# See Almesberger, Werner; Hadi Salim, Jamal; Kuznetsov, Alexey
+# "Differentiated Services on Linux"
+# http://www.almesberger.net/cv/papers/18270721.pdf
+#
+# **** 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::FairBlue;
+use strict;
+use warnings;
+
+require Vyatta::Config;
+use Vyatta::Qos::Util qw/getRate getAutoRate getTime/;
+
+my %qdiscOptions = (
+    'priority'      => \&prioQdisc,
+    'fair-queue'    => \&sfqQdisc,
+    'drop-tail'     => \&fifoQdisc,
+);
+
+# Create a new instance based on config information
+sub new {
+    my ( $that, $config, $name ) = @_;
+    my $level = $config->setLevel();
+
+    my $target = $config->returnValue("queue-target");
+    die "queue-target configuration missing\n" unless $target;
+    my $limit = $config->returnValue("queue-limit");
+    die "queue-limit configuration missing\n" unless $limit;
+    my $type = $config->returnValue("queue-type");
+    $type = "fair-queue" if (!defined($type));
+ 
+    my $pburst = $config->returnValue("penalty burst");
+    my $prate = $config->returnValue("penalty rate");
+
+    my $self = {};
+    my $class = ref($that) || $that;
+    bless $self, $class;
+
+    $self->{_target} = $target;
+    $self->{_limit}  = $limit;
+    $self->{_type}   = $type;
+    $self->{_pburst} = $pburst;
+    $self->{_prate}  = $prate;
+
+    sfqValidate($self, $level) if ($self->{_type} eq "fair-queue");
+
+    return $self;
+}
+
+sub sfqValidate {
+    my ( $self, $level ) = @_;
+    my $limit = $self->{_limit};
+
+    if ( defined $limit && $limit > 127 ) {
+        die "queue limit must be between 1 and 127 for queue-type fair-queue\n";
+    }
+}
+
+sub prioQdisc {
+    my ( $self, $dev ) = @_;
+    my $prio_id = 0x4000 + $self->{id};
+    my $limit   = $self->{_limit};
+
+    printf "handle %x: prio\n", $prio_id;
+
+    if ($limit) {
+        foreach my $i (qw/1 2 3/) {
+            printf "qdisc add dev %s parent %x:%x pfifo limit %d\n",
+              $dev, $prio_id, $i, $limit;
+        }
+    }
+}
+
+sub sfqQdisc {
+    my ( $self, $dev ) = @_;
+
+    print "sfq perturb 10";
+    print " limit $self->{_limit}" if ( $self->{_limit} );
+    print "\n";
+}
+
+sub fifoQdisc {
+    my ( $self, $dev ) = @_;
+
+    print "pfifo";
+    print " limit $self->{_limit}" if ( $self->{_limit} );
+    print "\n";
+}
+
+sub gen_leaf {
+    my ( $self, $dev, $parent ) = @_;
+    my $qtype = $self->{_type};
+    return unless $qtype;    # default is okay
+
+    my $q = $qdiscOptions{$qtype};
+    die "Unknown queue-type $qtype\n"
+      unless $q;
+
+    printf "qdisc add dev %s parent %x:%x ", $dev, $parent, 0;
+    $q->( $self, $dev );
+}
+
+sub commands {
+    my ( $self, $dev ) = @_;
+    my $root = 1;
+    printf("qdisc add dev %s root handle %x:0 sfb limit %d target %d ",
+             $dev, $root, $self->{_limit}, $self->{_target});
+    printf(" penalty_rate %d ", $self->{_prate}) if (defined $self->{_prate});
+    printf(" penalty_burst %d", $self->{_pburst}) if (defined $self->{_pburst});
+    print("\n");
+    gen_leaf( $self, $dev, $root);     
+}
+
+1;
diff --git a/lib/Vyatta/Qos/ShaperClass.pm b/lib/Vyatta/Qos/ShaperClass.pm
index 4afd90c..8da2a54 100644
--- a/lib/Vyatta/Qos/ShaperClass.pm
+++ b/lib/Vyatta/Qos/ShaperClass.pm
@@ -111,10 +111,67 @@ sub prioQdisc {
     }
 }
 
+sub sfbQdisc {
+    # Like RED, SFB can be quite complex. 
+    # However, unlike RED, the values for SFB can be approximated 
+    # with a better degree of success.
+    
+    # This is an attempt to get as close to optimal SFB options 
+    # it currently doesn't tune for increment and decrement so for large bandwidths
+    # this may not be optimal. 
+    # It is currently setup for 1000 byte packets and a 50 ms RTT.
+
+    my ( $self, $dev, $rate ) = @_;
+    my $sfb_id = 0x4000 + $self->{id};
+    my $avgpkt = 1000 * 8; # avgpkt in bits
+    my $limit = $self->{_limit};
+    my $latency = 0.1; # 50ms
+
+    my $target = ($rate * $latency)/$avgpkt; #target queue size in packets
+    $target = sprintf "%d", ($limit * 0.78) if ($target >= $limit);
+    $target = 1 if ($target < 1);
+
+    my $packet_rate = $rate/$avgpkt;
+    my $maxrate = $target/($latency); # use this value to keep penalty rate sane
+#    if ($maxrate < $packet_rate){
+#       print STDERR "Warning: queue-limit isn't long enough for desired bandwidth\n";
+#    }
+    $target = sprintf "%d", $target;
+
+    my $max = sprintf "%d", $target * 1.25;
+    $max = $limit if ($max >= $limit);
+
+    my $penalty_rate = sprintf "%d", ($maxrate)*0.1; # 10% of rate in pps
+    $penalty_rate = 1 if ($penalty_rate < 1);
+
+    my $penalty_burst = sprintf "%d", ($penalty_rate * $latency);
+    $penalty_burst = sprintf "%d", ($penalty_burst * 0.1)if ($penalty_burst >= $limit);
+    $penalty_burst = 1 if ($penalty_burst < 1);
+
+    printf "handle %x: sfb", $sfb_id; 
+    print  " target $target";
+    print  " max $max";
+    print  " limit $limit";
+    print  " penalty_rate $penalty_rate";
+    print  " penalty_burst $penalty_burst";
+    print  " increment 0.001";
+    print  " decrement 0.0002";
+    print  "\n";
+    printf STDERR "pktrate %d, maxrate %d, qtarget %d, qmax %d, prate %d, pburst %d",
+                    $packet_rate, $maxrate, $target, $max, $penalty_rate, $penalty_burst;
+
+    # Use SFQ where possible
+    if ($limit < 128){
+      printf "qdisc add dev %s parent %x: sfq perturb 10 limit %d\n", $dev, $sfb_id, $limit;
+    } else {
+      printf "qdisc add dev %s parent %x: pfifo limit %d\n", $dev, $sfb_id, $limit;
+    }
+}
+
 sub sfqQdisc {
     my ( $self, $dev, $rate ) = @_;
 
-    print "sfq";
+    print "sfq perturb 10";
     print " limit $self->{_limit}" if ( $self->{_limit} );
     print "\n";
 }
@@ -201,6 +258,7 @@ sub redValidate {
 my %qdiscOptions = (
     'priority'      => \&prioQdisc,
     'fair-queue'    => \&sfqQdisc,
+    'fair-blue'     => \&sfbQdisc,
     'random-detect' => \&redQdisc,
     'drop-tail'     => \&fifoQdisc,
 );