[LARTC] Perl Script for pulling information from a mysql database

["Adam Towarnyckyj" <adamt@commspeed.net>]

Here's the script. I would have posted it to a website, but I figure
this'll be better so it is always on the list for people in the future
in case they wanted to see it.
If you have any questions about any of it, please let me know. Mike and
I aren't the cleanest of programmers. Cron the script to run whenever
you need it to. :)

#!/usr/bin/perl
#
# TC Helper Script: Written by Mike Davis & Adam Towarnyckyj
#
#   Syncronizes data rates with MySQL server and applies hourly.
#

### Configuration Section ###


$dev = "eth1";
$tc = "/sbin/tc";
$mysql_host = "host";
$mysql_db = "database";
$mysql_user = "user";
$mysql_pass = "password";


### END Configuration Section ###

use POSIX qw(strftime);
use DBI;

# Database connect and define subroutines

$dsn = "DBI:mysql:database=$mysql_db;hostname=$mysql_host";
$dbh = DBI->connect($dsn, $mysql_user, $mysql_pass) || die "Can't
connect to database: " . DBI->errstr;

sub SelectSQL {
  my($sql) = @_;
  my @MATCHES, $hash;
  $sth = $dbh->prepare("$sql");
  $sth->execute();
  while ($hash = $sth->fetchrow_hashref) {
        push @MATCHES, $hash;
  }
  return @MATCHES;
}

sub SelectSingleSQL {
  my($sql) = @_;
  my($gotit, $return, $hash);
  $sth = $dbh->prepare("$sql");
  $sth->execute();
  while ($hash = $sth->fetchrow_array) {
        unless ($gotit) {
          $return = $hash;
          $gotit++;
        } else { warn "got multiple SQL returns when exepecting only
one"; }
  }
  return $return;
}

sub SimpleSQL {
  my($sql) = $_[0];
  my $rows_affected;
  $rows_affected = $dbh->do($sql);
  return $rows_affected;
}

sub Action {
  my($action) = @_;
#  print"Performing: $action\n";
  $warn=`$action 2>&1`;
  if ($warn) {
    chomp($warn);
    $prepare = "ERROR: $warn. Command was: $action";
#    print"WHOOPS: $warn\n";
    push @WARNING, $prepare;
  }
}

### Ok, now we start having fun.  Let's rebuild the tc tree.

# Remove existing tree and add the root.

Action("$tc qdisc del dev $dev root");
Action("$tc qdisc add dev $dev root handle 10:0 cbq bandwidth 200mbit
avpkt 1000");
Action("$tc class add dev $dev parent 10: classid 10:1 cbq bandwidth
200Mbit rate 200Mbit allot 1514 weight 2Mbit prio 8 maxburst 10 avpkt
1000");

# Get our list of accounts

@MODEMS = SelectSQL("SELECT mid, dsrate FROM modems");

# Figure out account IPs and put 'em in!

foreach $modem (@MODEMS) {
        if ($$modem{dsrate} = "0" || $$modem{dsrate} = "1") {
                next;
        }
        my @COMPUTERS = SelectSQL("SELECT ipid FROM computers WHERE
mid='$$modem{mid}'");
        foreach $computer (@COMPUTERS) {
                my $ip = SelectSingleSQL("SELECT ipaddr FROM ips WHERE
ipid='$$computer{ipid}'");
                my $rate = $$modem{dsrate} . "kbit";
                my $classid = sprintf("%X", $$computer{ipid});
                Action("$tc class add dev $dev parent 10: classid
10:$classid cbq bandwidth 200Mbit rate $rate allot 1514 prio 5 maxburst
20 avpkt 1000 

bounded");
                Action("$tc qdisc add dev $dev parent 10:$classid sfq
quantum 1514 perturb 15");
                Action("$tc filter add dev $dev parent 10:0 protocol ip
prio 25 u32 match ip dst $ip flowid 10:$classid");
        }
}

if (@WARNING) {
  print"WARNING: TCHELPER produced errors!  See below:\n @WARNING\n";
}

#
# Cool, everyone is now limited.

# Exit Nice and clean.

$dbh->disconnect;
exit(0);

_______________________________________________
LARTC mailing list / LARTC@mailman.ds9a.nl
http://mailman.ds9a.nl/mailman/listinfo/lartc HOWTO: http://lartc.org/