shapercontrol-1.3.4/000075500000000000000000000000001165425052100144015ustar00rootroot00000000000000shapercontrol-1.3.4/Makefile000064400000000000000000000030231165425052100160370ustar00rootroot00000000000000PROG=sc VERSION=1.3.4 ARCH=$(PROG)-$(VERSION).tar.bz2 DESTDIR?=/usr/local/sbin MANDIR?=/usr/local/share/man INITDIR?=/etc/init.d CFGDIR=/etc/sc CLFILES?=sc.8 sc.conf.5 $(ARCH) *.batch man: sc.8 sc.conf.5 sc.8: sc pod2man --section=8 --release=" " \ --center="Linux System Manager's Manual" $^ > $@ sc.conf.5: sc.conf.pod pod2man --section=5 --release=" " --center=" " $^ > $@ help: @echo "Targets:" ;\ echo " clean clean output files" ;\ echo " install install program" ;\ echo " help show this message" ;\ echo " man (default) generate manpages" ;\ echo " srcdist create archive with source distribution" ;\ echo " uninstall uninstall program" install: sc sc.init sc.conf.5 sc.8 sc.conf install -D -o root -g root -m 755 $(PROG) $(DESTDIR) install -D -o root -g root -m 755 $(PROG).init $(INITDIR)/$(PROG) install -D -o root -g root -m 644 sc.8 $(MANDIR)/man8 install -D -o root -g root -m 644 sc.conf.5 $(MANDIR)/man5 mkdir -p $(CFGDIR) if [ -f $(CFGDIR)/sc.conf ]; then \ install -D -o root -g root -m 644 sc.conf $(CFGDIR)/sc.conf.default ;\ else \ install -D -o root -g root -m 644 sc.conf $(CFGDIR) ;\ fi uninstall: -rm $(DESTDIR)/sc -rm $(INITDIR)/sc -rm $(MANDIR)/man8/sc.8 -rm $(MANDIR)/man5/sc.conf.5 -[ -f $(MANDIR)/man8/sc.8.gz ] && rm $(MANDIR)/man8/sc.8.gz -[ -f $(MANDIR)/man5/sc.conf.5.gz ] && rm $(MANDIR)/man5/sc.conf.5.gz reinstall: uninstall install clean: rm -f $(CLFILES) srcdist: hg archive -t tbz2 -X .hgtags -X .hgignore -X .hg_archival.txt $(ARCH) shapercontrol-1.3.4/README000064400000000000000000000075761165425052100153000ustar00rootroot00000000000000Shaper Control Tool Readme File Download & update ================= Project page at Sourceforge: http://sourceforge.net/projects/sc-tool/ Project page at BitBucket: http://bitbucket.org/sky/sc/ Source code repositories: http://bitbucket.org/sky/sc/src/ http://mercurial.intuxication.org/hg/sc/ http://sc-tool.hg.sourceforge.net/hgweb/sc-tool/ Installation ============ 0. Install Linux kernel that supports "u32" classifier (CONFIG_NET_CLS_U32), traffic control actions (CONFIG_NET_CLS_ACT, CONFIG_NET_ACT_GACT), traffic policing (CONFIG_NET_ACT_POLICE), and (optionally) "flow" classifier (CONFIG_NET_CLS_FLOW). 1. Install Perl 5 and the following modules: AppConfig, DBI, DBD-module for your database (DBD::Pg, DBD::SQLite, DBD::mysql, etc), Getopt::Long, Pod::Usage, Term::ANSIColor, Sys::Syslog. a. Installation from package repository of your Linux distribution. Example for Debian: # aptitude install perl perl-base perl-doc perl-modules libdbi-perl \ libdbd-sqlite3-perl libappconfig-perl b. Installation of modules from CPAN. # cpan AppConfig DBI DBD::SQLite Getopt::Long Pod::Usage \ Term::ANSIColor Sys::Syslog If you see that the output of "sc help" command is broken, please update Pod::Usage module from CPAN. 2. Install iproute2 suite. The latest version from is preferred. 3. Install iptables and ipset if you are planning to use "flow" classifier. 5. Install sc, manpages, configuration file and init script. # make install SC comes with prepared init script that should be installed to location /etc/init.d/sc. To enable automatic start of the shaper script you should create appropriate symlinks in the runlevel directories. In Debian and related distributives you may use the following command: # update-rc.d sc defaults Configuration and usage ======================= 1. Database settings By default, sc stores it's data in SQLite database at /etc/sc/sc.db, but it can use any other DBI-compatible database server like MySQL, PostgreSQL or Oracle. If you plan to load the data from a remote database on a dedicated server, you must install corresponding Perl DBD module, configure database driver and SQL-queries that will produce correct output for sc. The first column must contain an IP-addresses in integer representation, and the second column provides the integer bandwith rate values (see default value of "query_create" parameter). Rate units are defined by "rate_unit" parameter in sc.conf or by similar command line option. Default rate unit is 1 Kibit/s = 1024 bit/s. If you plan to use shaper with it's own SQLite database, you need to create it and add some data. # sc dbcreate # sc dbadd 172.16.0.1 10Mibit # sc dbadd 172.16.0.2 20Mibit You may also use "genbase" script to generate some database entries with random values of bandwidth rates. 2. Synchronization of rules with database To perform the synchronization of the shaping rules with the database entries you should edit your crontab file. The following example of crontab(5) entry creates the cron(8) task which performs the synchronization of the rules every 10 minutes: */10 * * * * root /usr/local/sbin/sc sync If you want to have rates that will differ from that stored in the database you should edit the rate_ratio in the sc.conf file with the suitable cron instruction. There is no need to reload the rules manually if you use the task for synchronization every 10 minutes from the example above. Examples of cron instructions for setting rate_ratio = 1.5 at 02:00 and changing it back to 1.0 at 07:00 every day: 0 2 * * * root sed -i 's/^rate_ratio.*=.*/rate_ratio = 1.5/g' /etc/sc/sc.conf 0 7 * * * root sed -i 's/^rate_ratio.*=.*/rate_ratio = 1.0/g' /etc/sc/sc.conf 3. Syslog SC can log errors and warnings through syslog. To enable this feature set "syslog" option to 1 in /etc/sc/sc.conf. shapercontrol-1.3.4/genbase000075500000000000000000000030311165425052100157300ustar00rootroot00000000000000#!/usr/bin/perl # genbase - generator of random data for sc databases use strict; use warnings; use Getopt::Long; my $rate_unit = 'kibit'; my $PROG = 'genbase'; my $VERSION = '1.0.0'; my $ip_i; my $ip_f; my $create = 0; my $help = 0; my %optd = ( 'i=s' => \$ip_i, 'f=s' => \$ip_f, 'create|c!' => \$create, 'help|h!' => \$help, ); GetOptions(%optd) or exit 1; usage(0) if $help; usage(1) if !defined $ip_i || !defined $ip_f; my $intip_i = ip_texttoint($ip_i); my $intip_f = ip_texttoint($ip_f); if ($intip_i > $intip_f || $intip_f - $intip_i > 2**16 - 1) { die "$PROG: IP interval ${ip_i}-${ip_f} is incorrect"; } open my $SCH, q{|-}, './sc -b' or die "$PROG: unable to open pipe for sc"; print $SCH "dbcreate\n" if $create; for my $i ($intip_i .. $intip_f) { my $rate = 1 << (int(rand(9)) + 7); print {$SCH} "dbadd ", ip_inttotext($i), " $rate$rate_unit\n"; } close $SCH or die "$PROG: unable to close pipe for sc"; exit(0); sub ip_texttoint { my $ip = shift; my @oct = split /\./ixms, $ip; my $int = 0; for my $i (0..3) { $int += $oct[$i]*( 1 << 8*(3-$i) ); } return $int; } sub ip_inttotext { my $int = shift; my @oct; for my $i (0..3) { my $div = 1 << 8*(3-$i); $oct[$i] = int($int/$div); $int %= $div; } return join q{.}, @oct; } sub usage { my $ret = shift; print STDERR <<"EOF" $PROG (version $VERSION) - generator of random data for sc databases Usage: $PROG [-c|--create] -i -f Example: $PROG -c -i 172.16.0.1 -f 172.16.5.255 $PROG -i 10.0.0.1 -f 10.0.1.255 EOF ; exit($ret); } shapercontrol-1.3.4/sc000075500000000000000000001612621165425052100147440ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Carp; use Getopt::Long qw( GetOptionsFromArray ); use DBI; use Pod::Usage; use Sys::Syslog; use AppConfig qw( :expand ); use Term::ANSIColor qw( :constants ); use POSIX qw( isatty ); # # Configurable parameters # my $cfg_file = '/etc/sc/sc.conf'; my $iptables = '/sbin/iptables'; my $tc = '/sbin/tc'; my $ipset = '/usr/local/sbin/ipset'; use constant { DEBUG_OFF => 0, # no debug output DEBUG_ON => 1, # print command line that caused error DEBUG_PRINT => 2, # print all commands instead of executing them }; my $debug = DEBUG_OFF; use constant { VERB_OFF => 0, # no verbose messages VERB_ON => 1, # enable messages VERB_NOBATCH => 2, # disable batch modes of tc and ipset }; my $verbose = VERB_OFF; my $quiet = 0; my $colored = 1; my $batch = 0; my $joint = 0; my $o_if = 'eth0'; my $i_if = 'eth1'; my $db_driver = 'sqlite'; my $db_host = '127.0.0.1'; my $db_user = 'username'; my $db_pass = 'password'; my $db_name = 'sc.db'; my $query_create = 'CREATE TABLE rates (ip UNSIGNED INTEGER PRIMARY KEY, '. 'rate UNSIGNED INTEGER NOT NULL)'; my $query_load = 'SELECT ip, rate FROM rates'; my $query_list = 'SELECT ip, rate FROM rates WHERE ip=?'; my $query_add = 'INSERT INTO rates VALUES (?, ?)'; my $query_del = 'DELETE FROM rates WHERE ip=?'; my $query_change = 'REPLACE INTO rates VALUES (?, ?)'; my $set_name = 'pass'; my $set_type = 'ipmap'; my $set_size = '65536'; my $chain_name = 'FORWARD'; my $policer_burst_ratio = 0.1; my $quantum = '1500'; my $rate_unit = 'kibit'; my $rate_ratio = 1.0; my $leaf_qdisc = 'pfifo limit 50'; my $network = '172.16.0.0/16'; my $filter_network = $network; my $filter_method = 'u32'; my $limit_method = 'shaping'; my (%filter_nets, %class_nets); my $syslog = 0; my $syslog_options = q{}; my $syslog_facility = 'user'; # # Internal variables and constants # my $PROG = 'sc'; my $VERSION = '1.3.4'; my $VERSTR = "Shaper Control Tool (version $VERSION)"; # command dispatch table my %cmdd = ( 'add' => { # handler (points to function that performs action) 'handler' => \&cmd_add, # database handler (optional) 'dbhandler' => \&cmd_dbadd, # arguments (optional) 'arg' => ' ', # command description 'desc' => 'add rules', # check root privileges before execution (optional) 'priv' => 1, }, 'calc' => { 'handler' => \&cmd_calc, 'arg' => '[ip]', 'desc' => 'calculate and print internally used values', 'priv' => 0, }, 'change|mod' => { 'handler' => \&cmd_change, 'dbhandler' => \&cmd_change, 'arg' => ' ', 'desc' => 'change rate', 'priv' => 1, }, 'del|rm' => { 'handler' => \&cmd_del, 'dbhandler' => \&cmd_dbdel, 'arg' => '', 'desc' => 'delete rules', 'priv' => 1, }, 'list|ls' => { 'handler' => \&cmd_list, 'arg' => '[ip] ...', 'desc' => 'list current rules in human-readable form', 'priv' => 1, }, 'help' => { 'handler' => \&cmd_help, 'desc' => 'show help and available database drivers', 'priv' => 0, }, 'init' => { 'handler' => \&cmd_init, 'desc' => 'initialization of rules', 'priv' => 1, }, 'sync' => { 'handler' => \&cmd_sync, 'desc' => 'synchronize rules with database', 'priv' => 1, }, 'load|start' => { 'handler' => \&cmd_load, 'desc' => 'load information from database and create all rules', 'priv' => 1, }, 'ratecvt' => { 'handler' => \&cmd_ratecvt, 'arg' => ' ', 'desc' => 'convert rate unit', 'priv' => 0, }, 'reload|restart' => { 'handler' => \&cmd_reload, 'desc' => 'reset and load rules', 'priv' => 1, }, 'reset|stop' => { 'handler' => \&cmd_reset, 'desc' => 'delete all shaping rules', 'priv' => 1, }, 'show' => { 'handler' => \&cmd_show, 'arg' => '[ip] ...', 'desc' => 'show rules explicitly', 'priv' => 1, }, 'status' => { 'handler' => \&cmd_status, 'desc' => 'show status of rules', 'priv' => 1, }, 'version' => { 'handler' => \&cmd_ver, 'desc' => 'output version and copyright information', 'priv' => 0, }, 'dbadd' => { 'handler' => \&cmd_dbadd, 'arg' => ' ', 'desc' => 'add database entry', 'priv' => 0, }, 'dbdel|dbrm' => { 'handler' => \&cmd_dbdel, 'arg' => '', 'desc' => 'delete database entry', 'priv' => 0, }, 'dblist|dbls' => { 'handler' => \&cmd_dblist, 'arg' => '[ip]', 'desc' => 'list database entries', 'priv' => 0, }, 'dbchange|dbmod' => { 'handler' => \&cmd_dbchange, 'arg' => ' ', 'desc' => 'change database entry', 'priv' => 0, }, 'dbcreate' => { 'handler' => \&cmd_dbcreate, 'desc' => 'create database and table', 'priv' => 0, }, ); # pointers to functions for rule handling my ($rul_init, $rul_add, $rul_del, $rul_change, $rul_load, $rul_batch_start, $rul_batch_stop, $rul_show, $rul_reset); # rate unit transformation coefficients my %units = ( # bit-based 'bit' => 1, 'kibit|Kibit' => 2**10, 'kbit|Kbit' => 1_000, 'mibit|Mibit' => 2**20, 'mbit|Mbit' => 10**6, 'gibit|Gibit' => 2**30, 'gbit|Gbit' => 10**9, # byte-based 'bps|Bps' => 8, 'kibps|KiBps' => 2**13, 'kbps|KBps' => 8_000, 'mibps|MiBps' => 2**23, 'mbps|MBps' => 8*10**6, 'gibps|GiBps' => 2**33, 'gbps|GBps' => 8*10**9, ); # Error codes use constant { E_OK => 0, E_PARAM => 1, E_IP_COLL => 2, E_UNDEF => 3, E_EXIST => 4, E_NOTEXIST => 5, E_CMD => 6, E_PRIV => 7, }; # global return value my $RET = E_OK; # Preamble for usage and help message my $usage_preamble = <<"EOF" $VERSTR Usage: $PROG [options] command Commands: EOF ; # options dispatch table for AppConfig and Getopt::Long my %optd = ( 'f|config=s' => \$cfg_file, 'iptables=s' => \$iptables, 'tc=s' => \$tc, 'ipset=s' => \$ipset, 'o|out_if=s' => \$o_if, 'i|in_if=s' => \$i_if, 'filter_method=s' => \$filter_method, 'limit_method=s' => \$limit_method, 'd|debug=i' => \$debug, 'v|verbose=i' => \$verbose, 'q|quiet!' => \$quiet, 'c|colored!' => \$colored, 'j|joint!' => \$joint, 'b|batch!' => \$batch, 'N|network=s' => \$network, 'filter_network=s' => \$filter_network, 'policer_burst_ratio=s' => \$policer_burst_ratio, 'quantum=s' => \$quantum, 'u|rate_unit=s' => \$rate_unit, 'r|rate_ratio=f' => \$rate_ratio, 'leaf_qdisc=s' => \$leaf_qdisc, 'chain=s' => \$chain_name, 's|set_name=s' => \$set_name, 'set_type=s' => \$set_type, 'set_size=s' => \$set_size, 'db_driver=s' => \$db_driver, 'db_host=s' => \$db_host, 'db_name=s' => \$db_name, 'db_user=s' => \$db_user, 'db_pass=s' => \$db_pass, 'query_create=s' => \$query_create, 'query_load=s' => \$query_load, 'query_list=s' => \$query_list, 'query_add=s' => \$query_add, 'query_del=s' => \$query_del, 'query_change=s' => \$query_change, 'S|syslog' => \$syslog, 'syslog_options' => \$syslog_options, 'syslog_facility=s' => \$syslog_facility, ); my %db_data; my %rul_data; # handlers and pointers for execution of external commands my ($TC_H, $IPS_H); my $TC = \&tc_sys; my $IPS = \&ips_sys; my $sys; # pref values for different types of tc filters my $pref_hash = 10; # hashing filters and flow my $pref_leaf = 20; # hash table entries my $pref_default = 30; # default rule my $ip_re = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}'; # # Main routine # # parse command line to get the name of configuration file properly my @argv = @ARGV; GetOptionsFromArray(\@argv, %optd) or exit E_PARAM; my $batch_cl = $batch; # read configuration file if (-T $cfg_file) { my @args = keys %optd; my @cargs = @args; my $cfg = AppConfig->new({ CASE => 1, GLOBAL => { EXPAND => EXPAND_VAR | EXPAND_ENV } }); $cfg->define(@args); $cfg->file($cfg_file); # prepare list of configuration file parameters and get their values for my $i (0..$#cargs) { $cargs[$i] =~ s/^\w+\|//ixms; $cargs[$i] =~ s/[=!+].*$//ixms; ${ $optd{$args[$i]} } = $cfg->get( $cargs[$i] ); } } else { log_carp("unable to read configuration file $cfg_file"); } # override values that we read from file by the command line parameters GetOptions(%optd) or exit E_PARAM; if ($batch) { # command queue for batch mode my @queue; while (my $c = <>) { chomp $c; next if $c =~ /^\s*$/ixms; next if $c =~ /^\#/ixms; $c =~ s/\s+\#.*$//ixms; push @queue, $c; } foreach (@queue) { my @a = split /\ /ixms; $RET = main(@a); } } else { $RET = main(@ARGV); } exit $RET; ## end of main routine sub main { my @argv = @_; my $ret = E_OK; # process command line in batch mode if ($batch) { GetOptionsFromArray(\@argv, %optd) or return E_PARAM; } usage(E_CMD) if !defined $argv[0]; my $cmd = acomp_cmd($argv[0]); usage(E_CMD) if !defined $cmd; return E_CMD if $cmd eq q{}; if ($cmdd{$cmd}{'priv'} && !$debug && $>) { log_warn('you must run this command with root privileges'); return E_PRIV; } # prepare all settings set_ptrs(); set_class_nets(); set_filter_nets(); local $ENV{ANSI_COLORS_DISABLED} = 1 if !($colored && isatty(\*STDOUT)); # call handler shift @argv; $ret = $cmdd{$cmd}{'handler'}->(@argv); # process return values if (!defined $ret) { $ret = -1; return $ret; } elsif ($ret == E_NOTEXIST) { log_carp("specified IP does not exist. Arguments: @argv"); } elsif ($ret == E_EXIST) { log_carp("specified IP already exists. Arguments: @argv"); } if ($joint && defined $cmdd{$cmd}{'dbhandler'}) { $ret = $cmdd{$cmd}{'dbhandler'}->(@argv); if ($ret == E_NOTEXIST) { log_carp( 'database entry for specified IP does not exist. '. "Arguments: @argv" ); } elsif ($ret == E_EXIST) { log_carp( 'database entry for specified IP already exists. '. "Arguments: @argv" ); } } return $ret; } sub usage { my ($ret) = @_; print $usage_preamble; print_cmds(); print "\n"; exit $ret; } sub print_cmds { my @cmds = sort keys %cmdd; my ($maxcmdlen, $maxarglen) = (0, 0); my @colspace = (2, 2, 3); my ($al, $cl); my %lengths; # find maximum length of command and arguments foreach my $key (@cmds) { my @aliases = split /\|/ixms, $key; $lengths{$key}{'cmd'} = $aliases[0]; $cl = length $aliases[0]; $lengths{$key}{'cmdl'} = $cl; $maxcmdlen = $cl if $maxcmdlen < $cl; $al = (defined $cmdd{$key}{'arg'}) ? length $cmdd{$key}{'arg'} : 0; $lengths{$key}{'argl'} = $al; $maxarglen = $al if $maxarglen < $al; } foreach my $key (@cmds) { next unless nonempty($cmdd{$key}{'desc'}); print q{ } x $colspace[0], $lengths{$key}{'cmd'}, q{ } x ($maxcmdlen - $lengths{$key}{'cmdl'} + $colspace[1]); print $cmdd{$key}{'arg'} if defined $cmdd{$key}{'arg'}; print q{ } x ($maxarglen - $lengths{$key}{'argl'} + $colspace[2]), $cmdd{$key}{'desc'}, "\n"; } return; } sub set_ptrs { if ($debug == DEBUG_OFF) { $sys = ($quiet) ? sub { return system "@_ >/dev/null 2>&1"; } : sub { return system @_; }; } elsif ($debug == DEBUG_ON) { $sys = sub { my ($c) = @_; print RED, "$c\n", RESET if system $c; return $?; } } elsif ($debug == DEBUG_PRINT) { $sys = sub { return print "@_\n"; } } if ($filter_method eq 'flow') { $rul_batch_start = sub { unless ($verbose & VERB_NOBATCH) { tc_batch_start(); ips_batch_start(); } }; $rul_batch_stop = sub { unless ($verbose & VERB_NOBATCH) { tc_batch_stop(); ips_batch_stop(); } ipt_init(); }; $rul_init = \&flow_init; $rul_add = \&flow_add; $rul_del = \&flow_del; $rul_change = \&htb_change; $rul_load = \&flow_load; $rul_show = \&flow_show; $rul_reset = \&flow_reset; } elsif ($filter_method eq 'u32') { $rul_batch_start = sub { tc_batch_start() unless $verbose & VERB_NOBATCH; }; $rul_batch_stop = sub { tc_batch_stop() unless $verbose & VERB_NOBATCH; }; if ($limit_method eq 'shaping') { $rul_init = \&u32_init; $rul_add = \&u32_add; $rul_del = \&u32_del; $rul_change = \&htb_change; $rul_load = \&u32_load; $rul_show = \&u32_show; $rul_reset = \&htb_reset; } elsif ($limit_method eq 'policing') { $rul_init = \&pol_init; $rul_add = \&pol_add; $rul_del = \&pol_del; $rul_change = \&pol_add; $rul_load = \&pol_load; $rul_show = \&pol_show; $rul_reset = \&pol_reset; } elsif ($limit_method eq 'hybrid') { $rul_init = \&hybrid_init; $rul_add = \&hybrid_add; $rul_del = \&hybrid_del; $rul_change = \&hybrid_change; $rul_load = \&pol_load; $rul_show = \&hybrid_show; $rul_reset = \&hybrid_reset; } else { log_croak( "\'$limit_method\' is invalid value for limit_method" ); } } else { if ($limit_method eq 'policing') { log_croak( 'Policing can be used only when filter_method = u32' ); return; } log_croak( "\'$filter_method\' is invalid value for filter_method" ); } return; } sub nonempty { my ($str) = @_; return (defined $str && $str ne q{}); } sub round { my ($n) = @_; return int($n + .5*($n <=> 0)); } # autocompletion for commands sub acomp_cmd { my ($input) = @_; my @match; my @ambig; foreach my $key (keys %cmdd) { my @cmds = split /\|/ixms, $key; foreach my $a (@cmds) { if ($a =~ /^$input/xms) { push @match, $key; push @ambig, $a; last; } } } if ($#match == 0) { return $match[0]; } elsif ($#match > 0) { log_warn("command \'$input\' is ambiguous:\n @ambig"); return q{}; } else { log_warn("unknown command \'$input\'\n"); return; } } sub log_syslog { my ($severity, $msg) = @_; openlog($PROG, $syslog_options, $syslog_facility); syslog($severity, $msg); closelog(); return $!; } sub log_carp { my ($msg) = @_; log_syslog('warn', $msg) if $syslog; carp "$PROG: $msg" if !$quiet; return $!; } sub log_croak { my ($msg) = @_; log_syslog('err', $msg) if $syslog; if ($quiet) { exit $!; } else { croak "$PROG: $msg"; } } sub log_warn { my ($msg) = @_; log_syslog('warn', $msg) if $syslog; print {*STDERR} "$PROG: $msg\n" if !$quiet; return $!; } sub arg_check { my ($issub, $arg, $argname) = @_; my $result = 0; log_croak("$argname is undefined") if !defined $arg; $result = $issub->($arg); log_croak("$arg is invalid $argname") if !$result; return $result; } sub is_ip { my ($ip) = @_; chomp $ip; if ($ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ixms) { if ($1 > 0 && $1 < 255 && $2 >= 0 && $2 <= 255 && $3 >= 0 && $3 <= 255 && $4 >= 0 && $4 <= 255) { return $ip; } } return 0; } sub is_rate { my ($rate) = @_; chomp $rate; my $result = 0; my ($num, $unit); if (($num, $unit) = $rate =~ /^([0-9]+)([A-z]*)$/xms) { return 0 if $num == 0; if (nonempty($unit)) { foreach my $u (keys %units) { if ($unit =~ /^(?:$u)$/xms) { $result = $rate; last; } } } else { $result = $num . $rate_unit; } } else { return 0; } return $result; } sub ip_inttotext { my ($int) = @_; my @oct; for my $i (0..3) { my $div = 1 << 8*(3-$i); $oct[$i] = int $int/$div; $int %= $div; } return join q{.}, @oct; } sub ip_texttoint { my ($ip) = @_; my @oct = split /\./ixms, $ip; my $int = 0; for my $i (0..3) { $int += $oct[$i] * (1 << 8*(3-$i)); } return $int; } sub rate_cvt { my ($rate, $dst_unit) = @_; my ($num, $unit, $s_key, $d_key); if (($num) = $rate =~ /^([0-9]+)([A-z]*)$/xms) { $unit = nonempty($2) ? $2 : $rate_unit; return $rate if $unit eq $dst_unit; foreach my $u (keys %units) { if ($unit =~ /^($u)$/xms) { $s_key = $u; last; } } } else { log_croak('invalid rate specified'); } log_croak('invalid source unit specified') if !defined $s_key; foreach my $u (keys %units) { if ($dst_unit =~ /^($u)$/xms) { $d_key = $u; last; } } log_croak('invalid destination unit specified') if !defined $d_key; my $dnum = round($num * $units{$s_key} / $units{$d_key}); return "$dnum$dst_unit"; } sub db_connect { my $dbh; if ($db_driver =~ /sqlite/ixms) { $dbh = DBI->connect( "DBI:SQLite:${db_name}", $db_user, $db_pass, { RaiseError => 1, AutoCommit => 1 } ); } else { $dbh = DBI->connect( "DBI:${db_driver}:dbname=$db_name;host=$db_host", $db_user, $db_pass, { RaiseError => 1, AutoCommit => 1 } ); } return $dbh; } sub db_load { my $dbh = db_connect(); my $sth = $dbh->prepare($query_load); $sth->execute(); my ($intip, $rate, $ip, $cid); while (my $ref = $sth->fetchrow_arrayref()) { ($intip, $rate) = @{$ref}; if (!defined $rate) { log_carp("IP $ip has undefined rate, skipping\n"); next; } $ip = ip_inttotext($intip); $cid = ip_classid($ip); $db_data{$cid}{'rate'} = $rate; $db_data{$cid}{'ip'} = $ip; } $sth->finish(); undef $sth; $dbh->disconnect(); return $dbh; } # # Common rule processing functions # sub set_class_nets { my $cid_min = 2; my $cid_max = 0xFFFF; my $cid_i = $cid_min; foreach my $n (split /\ /ixms, $network) { my ($netip, $netmask) = split /\//ixms, $n; log_croak("network mask $netmask is not supported. Network: $n") if $netmask < 16; $class_nets{$n}{'ip'} = $netip; $class_nets{$n}{'mask'} = $netmask; my $invmask = 2**(32 - $netmask) - 1; my $intmask = 2**32 - 1 - $invmask; my $ip_i = ip_texttoint($netip) & $intmask; $class_nets{$n}{'invmask'} = $invmask; $class_nets{$n}{'intip_i'} = $ip_i; $class_nets{$n}{'intip_f'} = $ip_i + $invmask; $class_nets{$n}{'classid_i'} = $cid_i; $cid_i += $invmask + 1; log_croak("network $n overfulls classid space") if $cid_i - $cid_min - 1 > $cid_max; } return; } sub ip_classid { my ($ip) = @_; my $intip = ip_texttoint($ip); my $cid; foreach my $n (keys %class_nets) { if ($intip >= $class_nets{$n}{'intip_i'} && $intip <= $class_nets{$n}{'intip_f'}) { my $offset = $intip & $class_nets{$n}{'invmask'}; $cid = sprintf '%x', $class_nets{$n}{'classid_i'} + $offset; last; } } log_croak( "$ip does not belong to any of specified networks: $network" ) if !defined $cid; return $cid; } sub print_rules { my ($comment, @cmds) = @_; my @out; my $PIPE; foreach my $c (@cmds) { open $PIPE, '-|', $c or log_croak("unable to open pipe for $c"); push @out, <$PIPE>; close $PIPE or log_croak("unable to close pipe for $c"); } if (@out) { print BOLD, "$comment\n", RESET if nonempty($comment); print @out; } return $?; } sub tc_sys { my ($c) = @_; return $sys->("$tc $c"); } sub tc_batch { my ($c) = @_; return print {$TC_H} "$c\n"; } sub tc_batch_start { if ($debug == DEBUG_PRINT) { open $TC_H, '>', 'tc.batch' or log_croak('unable to open tc.batch'); } else { open $TC_H, '|-', "$tc -batch" or log_croak("unable to create pipe for $tc"); } $TC = \&tc_batch; return $TC_H; } sub tc_batch_stop { $TC = \&tc_sys; return close $TC_H; } sub htb_change { my ($ip, $cid, $rate) = @_; my $ceil = $rate; htb_dev_change($i_if, $cid, $rate, $ceil); htb_dev_change($o_if, $cid, $rate, $ceil); return $?; } sub htb_dev_change { my ($dev, $cid, $rate, $ceil) = @_; $TC->( "class change dev $dev parent 1:0 classid 1:$cid htb ". "rate $rate ceil $ceil quantum $quantum" ); return $?; } sub htb_reset { $sys->("$tc qdisc del dev $o_if root handle 1: htb"); $sys->("$tc qdisc del dev $i_if root handle 1: htb"); return $?; } # # Flow filter functions # sub flow_init { flow_dev_init($i_if); flow_dev_init($o_if); if ($set_type eq 'ipmap') { $IPS->("-N $set_name $set_type --network $network"); } elsif ($set_type eq 'iphash') { $IPS->("-N $set_name $set_type --hashsize $set_size"); } else { log_croak("unknown set type \'$set_type\' specified"); } return $?; } sub flow_dev_init { my ($dev) = @_; $TC->("qdisc add dev $dev root handle 1: htb"); $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_hash ". "handle 1 flow map key src and 0xffff" ); return $?; } sub flow_add { my ($ip, $cid, $rate) = @_; my $ceil = $rate; flow_dev_add($i_if, $cid, $rate, $ceil); flow_dev_add($o_if, $cid, $rate, $ceil); $IPS->("-A $set_name $ip"); return $?; } sub flow_dev_add { my ($dev, $cid, $rate, $ceil) = @_; $TC->( "class replace dev $dev parent 1: classid 1:$cid ". "htb rate $rate ceil $ceil quantum $quantum" ); $TC->( "qdisc replace dev $dev parent 1:$cid handle $cid:0 $leaf_qdisc" ); return $?; } sub flow_del { my ($ip, $cid) = @_; $IPS->("-D $set_name $ip"); flow_dev_del($i_if, $cid); flow_dev_del($o_if, $cid); return $?; } sub flow_dev_del { my ($dev, $cid) = @_; $TC->("qdisc del dev $dev parent 1:$cid handle $cid:0"); $TC->("class del dev $dev parent 1: classid 1:$cid"); return $?; } sub flow_load { my ($ip, $cid, $rate); my $ret = E_OK; open my $IPH, '-|', "$ipset -nsL $set_name" or log_croak("unable to open pipe for $ipset"); my @ipsout = <$IPH>; close $IPH or log_carp("unable to close pipe for $ipset"); foreach (@ipsout) { next unless /^$ip_re/xms; chomp; $ip = $_; $cid = ip_classid($ip); if (defined $rul_data{$cid}{'ip'}) { log_carp('IP-to-classid collision detected, skipping. OLD: '. $rul_data{$cid}{'ip'}.", NEW: $ip"); $ret = E_IP_COLL; next; } $rul_data{$cid}{'ip'} = $ip; } open my $TCCH, '-|', "$tc class show dev $i_if" or log_croak("unable to open pipe for $tc"); my @tcout = <$TCCH>; close $TCCH or log_carp("unable to close pipe for $tc"); foreach (@tcout) { if (($cid, $rate) = /leaf\ ([0-9a-f]+):\ .*\ rate\ (\w+)/xms) { next if !defined $rul_data{$cid}; $rate = rate_cvt($rate, $rate_unit); $rul_data{$cid}{'rate'} = $rate; } } return $ret; } sub flow_show { my @ips = @_; if (nonempty($ips[0])) { foreach my $ip (@ips) { my $cid = ip_classid($ip); print_rules( "TC rules for $ip\n\nInput class [$i_if]:", "$tc -i -s -d class show dev $i_if | ". "grep -F -w -A 3 \"leaf $cid\:\"" ); print_rules( "\nOutput class [$o_if]:", "$tc -i -s -d class show dev $o_if | ". "grep -F -w -A 3 \"leaf $cid\:\"" ); print_rules( "\nInput qdisc [$i_if]:", "$tc -i -s -d qdisc show dev $i_if | ". "grep -F -w -A 2 \"$cid\: parent 1:$cid\"" ); print_rules( "\nOutput qdisc [$o_if]:", "$tc -i -s -d qdisc show dev $o_if | ". "grep -F -w -A 2 \"$cid\: parent 1:$cid\"" ); print_rules("\nIPSet entry for $ip:", "$ipset -T $set_name $ip"); print "\n"; } } else { print BOLD, "FILTERS:\n", RESET; system "$tc -p -s filter show dev $i_if"; system "$tc -p -s filter show dev $o_if"; print BOLD, "\nCLASSES:\n", RESET; system "$tc -i -s -d class show dev $i_if"; system "$tc -i -s -d class show dev $o_if"; print BOLD, "\nQDISCS:\n", RESET; system "$tc -i -s -d qdisc show dev $i_if"; system "$tc -i -s -d qdisc show dev $o_if"; print BOLD, "\nIPTABLES RULES:\n", RESET; system "$iptables -nL"; } return $?; } sub flow_reset { ipt_reset(); htb_reset(); return $?; }; # iptables & ipset functions sub ipt_init { $sys->("$iptables --policy FORWARD DROP"); if ($chain_name ne 'FORWARD') { $sys->("$iptables --new-chain $chain_name"); $sys->("$iptables -A FORWARD -j $chain_name"); } $sys->( "$iptables -A $chain_name -p all -m set --set $set_name src -j ACCEPT" ); $sys->( "$iptables -A $chain_name -p all -m set --set $set_name dst -j ACCEPT" ); return $?; } sub ipt_reset { if ($chain_name ne 'FORWARD') { $sys->("$iptables --delete FORWARD -j $chain_name"); $sys->("$iptables --flush $chain_name"); $sys->("$iptables --delete-chain $chain_name"); } else { $sys->( "$iptables -D $chain_name -p all -m set --set $set_name src ". '-j ACCEPT' ); $sys->( "$iptables -D $chain_name -p all -m set --set $set_name dst ". '-j ACCEPT' ); } $sys->("$ipset --flush $set_name"); $sys->("$ipset --destroy $set_name"); return $?; } sub ips_sys { my ($c) = @_; return $sys->("$ipset $c"); } sub ips_batch { my ($c) = @_; return print {$IPS_H} "$c\n"; } sub ips_batch_start { if ($debug == DEBUG_PRINT) { open $IPS_H, '>', 'ipset.batch' or log_croak('unable to open ipset.batch'); } else { open $IPS_H, '|-', "$ipset --restore" or log_croak("unable to create pipe for $ipset"); } $IPS = \&ips_batch; return $IPS_H; } sub ips_batch_stop { $IPS = \&ips_sys; print $IPS_H "COMMIT\n"; return close $IPS_H; } # # u32 hashing filters functions # sub set_filter_nets { # I restrict this value to a 0x799 to avoid discontinuity of filter space. # Real maximum number of u32 hash tables is 0xfff. my $ht_max = 0x799; # Initial numbers for hash tables of 1st and 2nd nesting levels # # Real minimal number of u32 hash tables is 1. 0x100 is taken for # simplicity. my $ht1 = 256; # Difference between initial numbers for hash tables of 1st and 2nd # nesting levels. Increase this value if you want to set more than 255 # netmasks to filter_network parameter. my $ht_21 = 256; my $ht2 = $ht1 + $ht_21; foreach my $n (split /\ /ixms, $filter_network) { my ($netip, $netmask) = split /\//ixms, $n; if ($netmask >= 24 && $netmask < 32) { $filter_nets{$n}{'leafht_i'} = $ht1; } elsif ($netmask >= 16 && $netmask < 24) { $filter_nets{$n}{'leafht_i'} = $ht2; $ht2 += 2**(24 - $netmask); } else { log_croak("network mask $netmask is not supported. Network: $n"); } $filter_nets{$n}{'ip'} = $netip; $filter_nets{$n}{'mask'} = $netmask; my $invmask = 2**(32 - $netmask) - 1; my $intmask = 2**32 - 1 - $invmask; my $ip_i = ip_texttoint($netip) & $intmask; $filter_nets{$n}{'invmask'} = $invmask; $filter_nets{$n}{'intip_i'} = $ip_i; $filter_nets{$n}{'intip_f'} = $ip_i + $invmask; $filter_nets{$n}{'ht'} = $ht1; ++$ht1; log_croak("network $n overfulls filter space") if $ht2 > $ht_max; } return; } # calculate leaf hash table and bucket number # # input: IP address # output: leaf hash key, bucket number sub ip_leafht_key { my ($ip) = @_; my $intip = ip_texttoint($ip); my ($leafht, $key); foreach my $n (keys %filter_nets) { if ($intip >= $filter_nets{$n}{'intip_i'} && $intip <= $filter_nets{$n}{'intip_f'}) { # 3rd octet my $ht_offset = ($intip & $filter_nets{$n}{'invmask'}) >> 8; # 4th octet $key = sprintf '%x', $intip & 0xFF; $leafht = sprintf '%x', $filter_nets{$n}{'leafht_i'} + $ht_offset; last; } } log_croak( "$ip does not belong to any of specified networks: $network" ) if !defined $leafht; return ($leafht, $key); } # calculate divisor and hashkey mask # # netmask = mask in decimal form # n = number of octet sub u32_div_hmask { my ($netmask, $n) = @_; log_croak("$n is invalid number of octet") if $n < 1 || $n > 4; # get n-th byte from netmask my $inthmask = (2**(32 - $netmask) - 1) & (0xFF << 8*(4-$n)); my $hmask = sprintf '0x%08x', $inthmask; my $div = ($inthmask >> 8*(4-$n)) + 1; return ($div, $hmask); } # u32 hashing filters with shaping sub u32_init { u32_dev_init($o_if, 'src', 12); u32_dev_init($i_if, 'dst', 16); return $?; } sub u32_dev_init { my ($dev, $match, $offset) = @_; $TC->("qdisc add dev $dev root handle 1: htb"); $TC->("filter add dev $dev parent 1:0 protocol ip pref $pref_hash u32"); foreach my $net (sort {$filter_nets{$a}{'ht'} <=> $filter_nets{$b}{'ht'}} keys %filter_nets) { my $ht1 = sprintf '%x', $filter_nets{$net}{'ht'}; my $netmask = $filter_nets{$net}{'mask'}; if ($netmask >= 24 && $netmask < 31) { my ($div1, $hmask1) = u32_div_hmask($netmask, 4); $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_hash ". "handle $ht1: u32 divisor $div1" ); $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_hash ". "u32 ht 800:: match ip $match $net ". "hashkey mask $hmask1 at $offset link $ht1:" ); } elsif ($netmask >= 16 && $netmask < 24) { my @oct = split /\./ixms, $filter_nets{$net}{'ip'}; my ($div1, $hmask1) = u32_div_hmask($netmask, 3); # parent filter $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_hash ". "handle $ht1: u32 divisor $div1" ); $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_hash ". "u32 ht 800:: match ip $match $net ". "hashkey mask $hmask1 at $offset link $ht1:" ); # child filters my ($div2, $hmask2) = u32_div_hmask($netmask, 4); for my $i (0 .. $div1 - 1) { my $key = sprintf '%x', $i; my $ht2 = sprintf '%x', $filter_nets{$net}{'leafht_i'} + $i; my $j = $oct[2] + $i; my $net2 = "$oct[0].$oct[1].$j.0/24"; $TC->( "filter add dev $dev parent 1:0 protocol ip ". "pref $pref_hash handle $ht2: u32 divisor $div2" ); $TC->( "filter add dev $dev parent 1:0 protocol ip ". "pref $pref_hash u32 ht $ht1:$key: ". "match ip $match $net2 ". "hashkey mask $hmask2 at $offset link $ht2:" ); } } else { log_croak("network mask \'\/$netmask\' is not supported"); } } # block all other traffic $TC->( "filter add dev $dev parent 1:0 protocol ip pref $pref_default ". 'u32 match u32 0 0 at 0 police mtu 1 action drop' ); return $?; } sub u32_add { my ($ip, $cid, $rate) = @_; my $ceil = $rate; my ($ht, $key) = ip_leafht_key($ip); u32_dev_add($i_if, $cid, $rate, $ceil, "ip dst $ip", $ht, $key); u32_dev_add($o_if, $cid, $rate, $ceil, "ip src $ip", $ht, $key); return $?; } sub u32_dev_add { my ($dev, $cid, $rate, $ceil, $match, $ht, $key) = @_; $TC->( "class replace dev $dev parent 1: classid 1:$cid htb ". "rate $rate ceil $ceil quantum $quantum" ); $TC->( "qdisc replace dev $dev parent 1:$cid handle $cid:0 $leaf_qdisc" ); $TC->( "filter replace dev $dev parent 1: pref $pref_leaf ". "handle $ht:$key:800 u32 ht $ht:$key: match $match flowid 1:$cid" ); return $?; } sub u32_del { my ($ip, $cid) = @_; my ($ht, $key) = ip_leafht_key($ip); u32_dev_del($i_if, $cid, $ht, $key); u32_dev_del($o_if, $cid, $ht, $key); return $? } sub u32_dev_del { my ($dev, $cid, $ht, $key) = @_; $TC->( "filter del dev $dev parent 1: pref $pref_hash ". "handle $ht:$key:800 u32" ); $TC->("qdisc del dev $dev parent 1:$cid handle $cid:0"); $TC->("class del dev $dev parent 1: classid 1:$cid"); return $?; } sub u32_load { my ($ip, $cid, $rate); my $ret = E_OK; open my $TCFH, '-|', "$tc -p -iec filter show dev $i_if" or log_croak("unable to open pipe for $tc"); my @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if (($ip) = $tcout[$i] =~ /match\ IP\ .*\ ($ip_re)\/32/xms) { if (($cid) = $tcout[$i-1] =~ /flowid\ 1:([0-9a-f]+)/xms) { $rul_data{$cid}{'ip'} = $ip; } } } open my $TCCH, '-|', "$tc class show dev $i_if" or log_croak("unable to open pipe for $tc"); @tcout = <$TCCH>; close $TCCH or log_carp("unable to close pipe for $tc"); foreach (@tcout) { if (($cid, $rate) = /leaf\ ([0-9a-f]+):\ .*\ rate\ (\w+)/xms) { next if !defined $rul_data{$cid}; $rate = rate_cvt($rate, $rate_unit); $rul_data{$cid}{'rate'} = $rate; } } return $ret; } sub u32_show { my @ips = @_; if (nonempty($ips[0])) { foreach my $ip (@ips) { arg_check(\&is_ip, $ip, 'IP'); my $cid; open my $TCFH, '-|', "$tc -p -s filter show dev $i_if" or log_croak("unable to open pipe for $tc"); my @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if ($tcout[$i] =~ /match\ IP\ .*\ $ip\/32/xms) { if (($cid) = $tcout[$i-1] =~ /flowid\ 1:([0-9a-f]+)/xms) { print BOLD, "TC rules for $ip\n\n", "Input filter [$i_if]:\n", RESET; print "$tcout[$i-1]\n$tcout[$i]\n"; print_rules( "\nOutput filter [$o_if]:", "$tc -p -s filter show dev $o_if | ". "grep -F -w -B 1 \"match IP src $ip/32\"" ); # tc class print_rules( "\nInput class [$i_if]:", "$tc -i -s -d class show dev $i_if | ". "grep -F -w -A 3 \"leaf $cid\:\"" ); print_rules( "\nOutput class [$o_if]:", "$tc -i -s -d class show dev $o_if | ". "grep -F -w -A 3 \"leaf $cid\:\"" ); # tc qdisc print_rules( "\nInput qdisc [$i_if]:", "$tc -i -s -d qdisc show dev $i_if | ". "grep -F -w -A 2 \"$cid\: parent 1:$cid\"" ); print_rules( "\nOutput qdisc [$o_if]:", "$tc -i -s -d qdisc show dev $o_if | ". "grep -F -w -A 2 \"$cid\: parent 1:$cid\"" ); print "\n"; last; } } } } } else { print BOLD, "FILTERS:\n", RESET; system "$tc -p -s filter show dev $i_if"; system "$tc -p -s filter show dev $o_if"; print BOLD, "\nCLASSES:\n", RESET; system "$tc -i -s -d class show dev $i_if"; system "$tc -i -s -d class show dev $o_if"; print BOLD, "\nQDISCS:\n", RESET; system "$tc -i -s -d qdisc show dev $i_if"; system "$tc -i -s -d qdisc show dev $o_if"; return $?; } return $?; } # u32 hashing filters with policing sub pol_init { pol_dev_init($o_if, 'dst', 16); pol_dev_init($i_if, 'src', 12); return $?; } sub pol_dev_init { my ($dev, $match, $offset) = @_; $TC->("qdisc add dev $dev handle ffff: ingress"); $TC->("filter add dev $dev parent ffff: protocol ip pref $pref_hash u32"); foreach my $net (sort {$filter_nets{$a}{'ht'} <=> $filter_nets{$b}{'ht'}} keys %filter_nets) { my $ht1 = sprintf '%x', $filter_nets{$net}{'ht'}; my $netmask = $filter_nets{$net}{'mask'}; if ($netmask >= 24 && $netmask < 31) { my ($div1, $hmask1) = u32_div_hmask($netmask, 4); $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash handle $ht1: u32 divisor $div1" ); $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash u32 ht 800:: match ip $match $net ". "hashkey mask $hmask1 at $offset link $ht1:" ); } elsif ($netmask >= 16 && $netmask < 24) { my @oct = split /\./ixms, $filter_nets{$net}{'ip'}; my ($div1, $hmask1) = u32_div_hmask($netmask, 3); # parent filter $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash handle $ht1: u32 divisor $div1" ); $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash u32 ht 800:: match ip $match $net ". "hashkey mask $hmask1 at $offset link $ht1:" ); # child filters my ($div2, $hmask2) = u32_div_hmask($netmask, 4); for my $i (0 .. $div1 - 1) { my $key = sprintf '%x', $i; my $ht2 = sprintf '%x', $filter_nets{$net}{'leafht_i'} + $i; my $j = $oct[2] + $i; my $net2 = "$oct[0].$oct[1].$j.0/24"; $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash handle $ht2: u32 divisor $div2" ); $TC->( "filter add dev $dev parent ffff: protocol ip ". "pref $pref_hash u32 ht $ht1:$key: ". "match ip $match $net2 ". "hashkey mask $hmask2 at $offset link $ht2:" ); } } else { log_croak("network mask \'\/$netmask\' is not supported"); } } # block all other traffic $TC->( "filter add dev $dev parent ffff:0 protocol ip pref $pref_default ". 'u32 match u32 0 0 at 0 police mtu 1 action drop' ); return $?; } sub pol_add { my ($ip, $cid, $rate) = @_; my $ceil = $rate; my ($ht, $key) = ip_leafht_key($ip); pol_dev_add($i_if, $rate, $ceil, "ip src $ip", $ht, $key); pol_dev_add($o_if, $rate, $ceil, "ip dst $ip", $ht, $key); return $?; } sub pol_dev_add { my ($dev, $rate, $ceil, $match, $ht, $key) = @_; my $rate_byte = rate_cvt($rate, 'bps'); $rate_byte =~ s/bps//gxms; my $policer_burst = round($policer_burst_ratio * $rate_byte) . 'b'; $TC->( "filter replace dev $dev parent ffff: pref $pref_leaf ". "handle $ht:$key:800 u32 ht $ht:$key: match $match ". "police rate $rate burst $policer_burst drop flowid ffff:" ); return $?; } sub pol_del { my ($ip, $cid) = @_; my ($ht, $key) = ip_leafht_key($ip); pol_dev_del($i_if, $ht, $key); pol_dev_del($o_if, $ht, $key); return $? } sub pol_dev_del { my ($dev, $ht, $key) = @_; $TC->( "filter del dev $dev parent ffff: pref $pref_hash ". "handle $ht:$key:800 u32" ); return $?; } sub pol_load { my ($ip, $cid, $rate); my $ret = E_OK; open my $TCFH, '-|', "$tc -p -iec filter show dev $i_if parent ffff:" or log_croak("unable to open pipe for $tc"); my @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if (($ip) = $tcout[$i] =~ /match\ IP\ .*\ ($ip_re)\/32/xms) { $cid = ip_classid($ip); if (($rate) = $tcout[$i+1] =~ /rate\ ([0-9A-z]+)/xms) { $rate = rate_cvt($rate, $rate_unit); $rul_data{$cid}{'ip'} = $ip; $rul_data{$cid}{'rate'} = $rate; } } } return $ret; } sub pol_show { my @ips = @_; if (nonempty($ips[0])) { foreach my $ip (@ips) { arg_check(\&is_ip, $ip, 'IP'); my $cid; my @tcout; open my $TCFH, '-|', "$tc -p -s -iec filter show dev $i_if parent ffff:" or log_croak("unable to open pipe for $tc"); @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if ($tcout[$i] =~ /match\ IP\ .*\ $ip\/32/xms) { print BOLD, "TC rules for $ip\n\n", "Input filter [$i_if]:\n", RESET; for my $j ($i-1 .. $i+1) { print "$tcout[$j]\n"; } last; } } open $TCFH, '-|', "$tc -p -s -iec filter show dev $o_if parent ffff:" or log_croak("unable to open pipe for $tc"); @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if ($tcout[$i] =~ /match\ IP\ .*\ $ip\/32/xms) { print BOLD, "Output filter [$o_if]:\n", RESET; for my $j ($i-1 .. $i+1) { print "$tcout[$j]\n"; } last; } } } } else { print BOLD, "POLICING FILTERS [$i_if]:\n", RESET; system "$tc -p -s filter show dev $i_if parent ffff:"; print BOLD, "POLICING FILTERS [$o_if]:\n", RESET; system "$tc -p -s filter show dev $o_if parent ffff:"; return $?; } return $?; } sub pol_reset { $sys->("$tc qdisc del dev $o_if handle ffff: ingress"); $sys->("$tc qdisc del dev $i_if handle ffff: ingress"); return $?; } # u32 hashing filters with policing and shaping sub hybrid_add { my ($ip, $cid, $rate) = @_; my $ceil = $rate; my ($ht, $key) = ip_leafht_key($ip); pol_dev_add($i_if, $rate, $ceil, "ip src $ip", $ht, $key); u32_dev_add($i_if, $cid, $rate, $ceil, "ip dst $ip", $ht, $key); return $?; } sub hybrid_del { my ($ip, $cid) = @_; my ($ht, $key) = ip_leafht_key($ip); pol_dev_del($i_if, $ht, $key); u32_dev_del($i_if, $cid, $ht, $key); return $? } sub hybrid_change { my ($ip, $cid, $rate) = @_; my $ceil = $rate; my ($ht, $key) = ip_leafht_key($ip); pol_dev_add($i_if, $rate, $ceil, "ip src $ip", $ht, $key); htb_dev_change($i_if, $cid, $rate, $ceil); return $?; } sub hybrid_show { my @ips = @_; if (nonempty($ips[0])) { foreach my $ip (@ips) { arg_check(\&is_ip, $ip, 'IP'); my $cid; my @tcout; open my $TCFH, '-|', "$tc -p -s -iec filter show dev $i_if parent ffff:" or log_croak("unable to open pipe for $tc"); @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if ($tcout[$i] =~ /match\ IP\ .*\ $ip\/32/xms) { print BOLD, "TC rules for $ip\n\n", "Policing filter [$i_if]:\n", RESET; for my $j ($i-1 .. $i+1) { print "$tcout[$j]"; } last; } } open $TCFH, '-|', "$tc -p -s filter show dev $i_if" or log_croak("unable to open pipe for $tc"); @tcout = <$TCFH>; close $TCFH or log_carp("unable to close pipe for $tc"); for my $i (0 .. $#tcout) { chomp $tcout[$i]; if ($tcout[$i] =~ /match\ IP\ .*\ $ip\/32/xms) { if (($cid) = $tcout[$i-1] =~ /flowid\ 1:([0-9a-f]+)/xms) { print BOLD, "Input filter [$i_if]:\n", RESET; print "$tcout[$i-1]\n$tcout[$i]\n"; print_rules( "\nShaping filter [$i_if]:", "$tc -p -s filter show dev $i_if | ". "grep -F -w -B 1 \"match IP dst $ip/32\"" ); print_rules( "\nShaping class [$i_if]:", "$tc -i -s -d class show dev $i_if | ". "grep -F -w -A 3 \"leaf $cid\:\"" ); print_rules( "\nShaping qdisc [$i_if]:", "$tc -i -s -d qdisc show dev $i_if | ". "grep -F -w -A 2 \"$cid\: parent 1:$cid\"" ); print "\n"; last; } } } } } else { print BOLD, "POLICING FILTERS [$i_if]:\n", RESET; system "$tc -p -s filter show dev $i_if parent ffff:"; print BOLD, "SHAPING FILTERS [$i_if]:\n", RESET; system "$tc -p -s filter show dev $i_if"; print BOLD, "\nSHAPING CLASSES [$i_if]:\n", RESET; system "$tc -i -s -d class show dev $i_if"; print BOLD, "\nSHAPING QDISCS [$i_if]:\n", RESET; system "$tc -i -s -d qdisc show dev $i_if"; return $?; } return $?; } sub hybrid_init { pol_dev_init($i_if, 'src', 12); u32_dev_init($i_if, 'dst', 16); return $?; } sub hybrid_reset { $sys->("$tc qdisc del dev $i_if handle ffff: ingress"); $sys->("$tc qdisc del dev $i_if root handle 1: htb"); return $?; } # # Command handlers # sub cmd_init { my $ret = E_OK; $rul_batch_start->(); $ret = $rul_init->(); $rul_batch_stop->(); return $ret; } sub cmd_reset { return $rul_reset->(); } sub cmd_add { my ($ip, $rate) = @_; arg_check(\&is_ip, $ip, 'IP'); $rate = arg_check(\&is_rate, $rate, 'rate'); my $cid = ip_classid($ip); return $rul_add->($ip, $cid, $rate); } sub cmd_del { my ($ip) = @_; arg_check(\&is_ip, $ip, 'IP'); my $cid = ip_classid($ip); return $rul_del->($ip, $cid); } sub cmd_change { my ($ip, $rate) = @_; arg_check(\&is_ip, $ip, 'IP'); $rate = arg_check(\&is_rate, $rate, 'rate'); my $cid = ip_classid($ip); return $rul_change->($ip, $cid, $rate); } sub cmd_list { my @ips = @_; my $ret = $rul_load->(); my $fmt = "%4s %-15s %11s\n"; if (nonempty($ips[0])) { foreach my $ip (@ips) { arg_check(\&is_ip, $ip, 'IP'); my $cid = ip_classid($ip); if (defined $rul_data{$cid}) { printf $fmt, $cid, $rul_data{$cid}{'ip'}, $rul_data{$cid}{'rate'}; } } } else { foreach my $cid (sort { hex $a <=> hex $b } keys %rul_data) { printf $fmt, $cid, $rul_data{$cid}{'ip'}, $rul_data{$cid}{'rate'}; } } return $ret; } sub cmd_load { my $ret = E_OK; $rul_batch_start->(); $ret = $rul_init->(); db_load(); foreach my $cid (keys %db_data) { my $r = round($rate_ratio*$db_data{$cid}{'rate'}); $rul_add->($db_data{$cid}{'ip'}, $cid, "$r$rate_unit"); } $rul_batch_stop->(); return $ret; } sub cmd_show { return $rul_show->(@_); } sub cmd_sync { my ($add, $del, $chg) = (0,0,0); $rul_load->(); db_load(); $rul_batch_start->(); # delete rules for IPs that is not in database foreach my $rcid (keys %rul_data) { if (!defined $db_data{$rcid} && defined $rul_data{$rcid}) { my $ip = $rul_data{$rcid}{'ip'}; print "- $ip\n" if $verbose & VERB_ON; $rul_del->($ip, $rcid); $del++; } } foreach my $dcid (keys %db_data) { # delete entries with zero rates if ($db_data{$dcid}{'rate'} == 0) { my $ip = $db_data{$dcid}{'ip'}; print "- $ip\n" if $verbose & VERB_ON; $rul_del->($ip, $dcid); $del++; next; } my $db_rate = round($rate_ratio*$db_data{$dcid}{'rate'}); $db_rate .= "$rate_unit"; # add new entries if (!defined $rul_data{$dcid}) { my $ip = $db_data{$dcid}{'ip'}; print "+ $ip\n" if $verbose & VERB_ON; $rul_add->($ip, $dcid, $db_rate); $add++; next; } # change if rate in database is different my $rul_rate = $rul_data{$dcid}{'rate'}; if ($rul_rate ne $db_rate) { my $ip = $db_data{$dcid}{'ip'}; print "* $ip $rul_rate -> $db_rate\n" if $verbose & VERB_ON; $rul_change->($ip, $dcid, $db_rate); $chg++; } else { next; } } $rul_batch_stop->(); return ($add, $del, $chg); } sub cmd_status { my @out; my $PIPE; open $PIPE, '-|', "$tc qdisc show dev $i_if" or log_croak("unable to open pipe for $tc"); @out = <$PIPE>; close $PIPE or log_croak("unable to close pipe for $tc"); my $rqdisc; if ($out[0] =~ /^qdisc\ htb/xms) { $rqdisc = 'htb'; } elsif (defined $out[1]) { if ($out[1] =~ /^qdisc\ ingress/xms) { $rqdisc = 'ingress'; } } else { log_warn('no shaping rules found'); return E_UNDEF; } if ($rqdisc eq 'htb') { my @lqd = split /\ /xms, $leaf_qdisc; my $lqdisk = $lqd[0]; shift @out; foreach my $s (@out) { chomp $s; if ($s =~ /qdisc\ $lqdisk\ ([0-9a-f]+):/xms) { log_warn('shaping rules were successfully created'); return E_OK; } } log_warn('htb qdisc found but there is no child queues'); } elsif ($rqdisc eq 'ingress') { open $PIPE, '-|', "$tc -p filter show dev $i_if parent ffff:" or log_croak("unable to open pipe for $tc"); @out = <$PIPE>; close $PIPE or log_croak("unable to close pipe for $tc"); foreach my $s (@out) { if ($s =~ /match\ IP.*\/32/xms) { log_warn('shaping rules were successfully created'); return E_OK; } } log_warn('ingress qdisc found but there is no filters for IPs'); return E_UNDEF; } return E_UNDEF; } sub cmd_ver { print "$VERSTR\n\n"; pod2usage({ -exitstatus => 'NOEXIT', -verbose => 99, -sections => 'LICENSE AND COPYRIGHT' }); return E_OK; } sub cmd_help { if ($verbose & VERB_ON) { pod2usage({ -exitstatus => 0, -verbose => 2 }); } else { my $linewidth = 80; my $indent = ' '; print "$VERSTR\n\n"; pod2usage({ -exitstatus => 'NOEXIT', -verbose => 99, -sections => 'SYNOPSIS|COMMANDS|OPTIONS', -output => \*STDOUT }); print "Available database drivers:\n"; my $drv = join q{ }, DBI->available_drivers; $drv =~ s/([^\n]{1,$linewidth})(?:\b\s*|\n)/$indent$1\n/goixms; print "$drv\n"; } return E_OK; } sub cmd_dbcreate { my $dbh = db_connect(); $dbh->do($query_create); $dbh->disconnect(); return $dbh; } sub cmd_reload { cmd_reset(); return cmd_load(); } sub cmd_dbadd { my ($ip, $rate) = @_; arg_check(\&is_ip, $ip, 'IP'); my $dbh = db_connect(); my $intip = ip_texttoint($ip); my $intrate = rate_cvt($rate, $rate_unit); $intrate =~ s/\D//gixms; my $sth = $dbh->prepare($query_add); $sth->execute($intip, $intrate); $sth->finish(); undef $sth; $dbh->disconnect(); return E_OK; } sub cmd_dbdel { my @ips = @_; my $dbh = db_connect(); my $sth; foreach my $ip (@ips) { arg_check(\&is_ip, $ip, 'IP'); my $intip = ip_texttoint($ip); $sth = $dbh->prepare($query_del); $sth->execute($intip); $sth->finish(); } undef $sth; $dbh->disconnect(); return E_OK; } sub cmd_dbchange { my ($ip, $rate) = @_; my $dbh = db_connect(); my $intip = ip_texttoint($ip); my $intrate = rate_cvt($rate, $rate_unit); $intrate =~ s/\D//gixms; my $sth = $dbh->prepare($query_change); $sth->execute($intip, $intrate); $sth->finish(); undef $sth; $dbh->disconnect(); return E_OK; } sub cmd_dblist { my ($ip) = @_; my $ret = E_OK; if (!defined $ip) { $ret = db_load(); foreach my $cid (sort { hex $a <=> hex $b } keys %db_data) { printf "%-15s %10s\n", $db_data{$cid}{'ip'}, "$db_data{$cid}{'rate'}$rate_unit"; } } else { arg_check(\&is_ip, $ip, 'IP'); my $intip = ip_texttoint($ip); my $rate; my $dbh = db_connect(); my $sth = $dbh->prepare($query_list); $sth->execute($intip); while (my $ref = $sth->fetchrow_arrayref()) { ($intip, $rate) = @{$ref}; printf "%-15s %10s\n", $ip, $rate . $rate_unit; } $sth->finish(); undef $sth; $dbh->disconnect(); } return $ret; } sub cmd_ratecvt { my ($rate, $unit) = @_; log_croak('rate is undefined') if !defined $rate; log_croak('destination unit is undefined') if !defined $unit; my $result; $result = rate_cvt($rate, $unit); print "$result\n"; return E_OK; } sub cmd_calc { my ($ip) = @_; if (!defined $ip) { use Data::Dumper; print Dumper(\%filter_nets); print Dumper(\%class_nets); return E_OK; } arg_check(\&is_ip, $ip, 'IP'); my $cid = ip_classid($ip); my ($ht, $key) = ip_leafht_key($ip); print "classid = $cid, leaf ht = $ht, key = $key\n"; return E_OK; } __END__ =head1 NAME B - administration tool for ISP traffic shaper =head1 SYNOPSIS B [options] B [ip] [rate] =head1 DESCRIPTION sc(8) is a command-line tool intended to simplify administration of traffic shaper for Internet service providers. ISP's usually work with the following configuration: every customer has it's own IP-address and fixed bandwidth. sc(8) works like a wrapper for tc(8), iptables(8) and ipset(8) abstracting you from complexity of their rules, so you can think only about IPs and bandwidth rates and almost forget about classid's, qdiscs, filters and other stuff. =head2 Main features =over =item * Fast loading of large rulesets by using batch modes of tc(8) and ipset(8). =item * Effective traffic classification with B hashing filters or B classifier. =item * Loading of data from any relational database supported by Perl DBI module. =item * Synchronization of rules with database. =item * Batch command execution mode for scripting purposes. =item * Support of different traffic limiting methods: shaping, policing, and hybrid. =back =head1 PREREQUISITES =head2 Perl modules DBI and corresponding database-dependent module (e.g. DBD::Pg for PostgreSQL, DBD::SQLite for SQLite, etc), AppConfig, Carp, Getopt::Long, Pod::Usage, Sys::Syslog, Term::ANSIColor. =head2 Command-line tools tc(8) from B suite. =head2 Linux kernel configuration =over =item * B classifier (option B=m or y) =item * Traffic control actions (B=y and B=m or y) =back =head1 COREQUISITES If you want to use B filtering method, you should install iptables(8) and ipset(8), B classifier (kernel version 2.6.25 or above, option B=m or y), and B kernel modules (see L for details). If you prefer policing as a rate limiting method, you should enable the kernel option B. =head1 COMMANDS =over 30 =item B Add rules for specified IP =item B [ip] Calculate and print internally used variables: classids, hash table numbers and keys. =item B | B Change rate for specified IP =item B Add database entry =item B | B Change database entry =item B Create database and table =item B | B Delete database entry =item B | B [ip] List database entries. If no IP specified, all entries are listed. =item B | B Delete rules =item B Show help for commands, options and list available database drivers. Generate and show manpage if B<-v 1> option is specified. =item B Initialization of firewall and QoS rules. Should be used only for manual rule editing. =item B | B [ip] List rules in a short and human-readable form. If no IP specified, all entries are listed. =item B | B Load IPs and rates from database and create ruleset =item B Convert rate from one unit to another =item B | B Reset rules and load database =item B | B Delete all shaping rules =item B [ip] Show rules explicitly. If no IP specified, all entries are listed. =item B Show status of shaping rules =item B Synchronize rules with database =item B Output version =back =head1 OPTIONS =over 8 =item B<-f>, B<--config> file Read configuration from specified file =item B<-o>, B<--out_if> if_name Name of output network interface =item B<-i>, B<--in_if> if_name Name of input network interface =item B<-d>, B<--debug> mode Possible values: =over =item B<0> no debug (default value), =item B<1> print command lines with nonzero return values, =item B<2> print all command lines without execution. =back =item B<-v>, B<--verbose> mode Possible values: =over =item B<0> no verbose messages (default) =item B<1> enable verbose messages (i.e. for results of `sync' command) =item B<2> disable usage of tc(8) and ipset(8) batch rule loading =item B<3> do B<1> + B<2> =back =item B<-q>, B<--quiet> Suppress output of error messages from external command-line tools like tc(8), iptables(8) and ipset(8). =item B<-c>, B<--colored> Colorize output of some commands =item B<-j>, B<--joint> Joint mode. Add, change and del commands will be applied to rules and database entries simultaneously. =item B<-b>, B<--batch> Batch mode. Commands and options will be read from STDIN. =item B<-N, --network> "net/mask ..." Network(s) for classid calculation or for C set (see sc.conf(5) for details). =item B<--filter_network> "net/mask ..." Network(s) for hashing filter generation (see sc.conf(5) for details). =item B<--policer_burst_ratio> real number Ratio between the size of policer buffer size and bandwidth rate. =item B<--quantum> size Amount of bytes a stream is allowed to dequeue before the next queue gets a turn. =item B<-u>, B<--rate_unit> unit Default rate unit =item B<-r>, B<--rate_ratio> real number Ratio between bandwidth rates in rules and in the database. Used only for B and B commands. =item B<-l>, B<--leaf_qdisc> string Leaf qdisc and parameters =item B<--chain> name Name of iptables(8) chain to use =item B<-s>, B<--set_name> name Name of IP set for storage of allowed IPs =item B<--set_type> type Type of IP set (ipmap or iphash) =item B<--set_size> size Size of IP set (up to 65536) =item B<--db_driver> name Database driver =item B<--db_host> host:port Database server address or hostname =item B<--db_name> name Database name to use =item B<--db_user> name Database username =item B<--db_pass> password Database password. Remember that it is insecure to specify password here. =item B<-S>, B<--syslog> Send errors and warnings to syslog =back =head1 RATE UNITS All rates should be specified as integer numbers, possibly followed by a unit. Bare number implies default unit (kibit). You may use another unit by changing C parameter in configuration file or by setting the similar command line option. =over 18 =item bit bit per second =item kibit, Kibit kibibit per second (1024) =item kbit or Kbit kilobit per second (1000) =item mibit or Mibit mebibit per second (1 048 576) =item mbit or Mbit megabit per second (10^6) =item gibit or Gibit gibibit per second (1 073 741 824) =item gbit or Gbit gigabit per second (10^9) =item bps or Bps byte per second =item kibps or KiBps kibibyte per second =item kbps or KBps kilobyte per second =item mibps or MiBps mebibyte per second =item mbps or MBps megabyte per second =item gibps or GiBps gibibyte per second =item gbps or GBps gigabyte per second =back =head1 USAGE =over =item Load accounts from database and create all rules C or C =item Add class for IP 172.16.0.1 with 256kibit/s. C =item Change rate to 512kibit/s C =item Delete rules for 172.16.0.1 C =item Reset all rules C =back =head1 CONFIGURATION By default B reads configuration from F file and uses SQLite database at F. See sc.conf(5) for details. =head1 DIAGNOSTICS The error messages are printed to standard error. To print the command lines that return nonzero error codes, use B<-d 1> option. To print all generated command lines without execution, use B<-d 2> option. To disable the usage of the batch modes of tc(8) and ipset(8), use B<-v 2> option. For more information please read the section B. Program may return one of the following exit codes or the exit code of the failed command line that aborted the execution: =over 4 =item B<0> correct functioning =item B<1> incorrect parameter =item B<2> IP-to-classid collision =item B<3> parameter is undefined =item B<4> IP already exists =item B<5> IP does not exist =item B<6> incorrect command =item B<7> insufficient privileges =back =head1 BUGS For performance reasons, script does not perform checks that require additional executions of external programs. =head1 RESTRICTIONS Due to limited number of classids (from 2 to ffff) you can create only 65534 classes on a single interface. For similar reasons sc(8) only supports networks with masks from /16 to /31. u32 classifier allows you to create several hashing filters for /16-/31 networks, but flow classifier works only with single /16 network. IPs from the different /16 networks with the same last two octets will be assigned to the same class. For simplicity of u32 hash table numbers calculation, the maximum number of entries in C parameter is 255, and the number of hashing filters is limited by 0x799. =head1 SEE ALSO sc.conf(5), tc(8), tc-htb(8), iptables(8), ipset(8), Getopt::Long(3), AppConfig(3), http://lartc.org/howto/lartc.adv-filter.hashing.html, http://www.mail-archive.com/netdev@vger.kernel.org/msg60638.html. =head1 AUTHOR Stanislav Kruchinin =head1 LICENSE AND COPYRIGHT Copyright (c) 2008-2012. Stanislav Kruchinin. License: GNU GPL version 2 or later This is free software: you are free to change and redistribute it. There is NO WARRANTY; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut shapercontrol-1.3.4/sc.conf000064400000000000000000000101701165425052100156540ustar00rootroot00000000000000# # sc.conf - configuration file for shaper control tool # # Location of executables tc = /usr/local/sbin/tc # iptables and ipset are required when filter_method = flow #iptables = /usr/local/sbin/iptables #ipset = /usr/local/sbin/ipset # Network interfaces out_if = eth0 in_if = eth1 # Traffic filtering method # # u32 - u32 hashing filters # flow - flow classifier with ipset filter_method = u32 # Rate limit method # # Possible values: shaping, policing or hybrid # # Policing can be used only when filter_method = u32. # Hybrid method uses shaping for download and policing for upload, and all # the rules are created only for the in_if interface. limit_method = shaping # Debugging mode # # 0 - no debugging # 1 - print command line that caused error # 2 - just print command line without execution debug = 0 # Message verbosity (boolean). # # 0 - no verbose messages # 1 - enable verbose messages (i.e. for results of `sync' command) # 2 - disable usage of tc(8) and ipset(8) batch rule loading # 3 - do 1 + 2 verbose = 0 # Suppress output (boolean) quiet = 0 # Colored output (boolean) colored = 1 # Edit both rules and database entries using add/del/change commands (boolean) joint = 0 # Network list for classid calculation # # Allowed numbers of tc classid's are 2--ffff, so the total number of hosts in # specified networks should be 65534 or less. E.g. allowed only one /16 # network, two /17 networks, and so on. Note, that `flow' classifier works # only with a single /16 network. Different networks are allowed only when # filter_method = u32. # # Allowed masks: 16-31 network = 10.0.0.0/20 10.0.254.0/24 172.16.0.0/20 # Networks for hashing filters generation # # Networks with the same two last octets are supported. # For simplicity of filter hash table numbers calculation, the maximum number # of different entries in this list is set to 255. # # Allowed masks: 16-31 filter_network = 10.0.0.0/16 172.16.0.0/20 # Ratio between the size of policer buffer size and bandwidth rate # # Default value: 0.1 policer_burst_ratio = 0.1 # Amount of bytes a stream is allowed to dequeue before the next queue gets a # turn. # # Default value: default MTU size for Ethernet (1500 bytes). # Warning: don't use values below the MTU size! quantum = 1500 # Default rate unit rate_unit = kibit # Ratio between bandwidth rates in rules and in the database. # rule_rate = db_rate * rate_ratio # # This coefficient is used only for B and B commands. # Default value: 1.0. # Possible values: any rational number. rate_ratio = 1.0 # Classless leaf qdisc with parameters leaf_qdisc = 'pfifo limit 50' # # ipset and iptables # # Name of set with allowed IP's #set_name = pass # Type of set # # ipmap - stores IPs from single /16 network (faster) # iphash - stores IPs from different networks #set_type = ipmap # Size of iphash set #set_size = 65536 # Name of iptables chain that will contain rules for shaped IPs # # NOTE: For names other than FORWARD the new chain will be created and # attached to FORWARD chain. #chain = FORWARD # # Database # # Driver # # Possible values: SQLite, mysql, Pg, Oracle. # Requires corresponding DBD module. # Use 'sc help' command to show available database drivers. db_driver = SQLite # Host db_host = 127.0.0.1 # Database name (or filename for SQLite driver) db_name = /etc/sc/sc.db # Username db_user = username # Password db_pass = password # Database queries query_create = "CREATE TABLE rates (ip UNSIGNED INTEGER PRIMARY KEY, rate UNSIGNED INTEGER NOT NULL)" query_load = "SELECT ip,rate FROM rates" query_list = "SELECT ip,rate FROM rates WHERE ip=?" query_add = "INSERT OR REPLACE INTO rates VALUES (?, ?)" query_del = "DELETE FROM rates WHERE ip=?" query_change = "REPLACE INTO rates VALUES (?, ?)" # # Logging # # Output errors and warnings to syslog syslog = 0 # syslog options (comma-separated) # # ndelay - open the connection immediately # nofatal - just emit warnings instead of dying if the connection to syslog # can't be established # perror - write the message to standard error output as well to the syslog # pid - include PID with each message #syslog_options = '' # facility #syslog_facility = user shapercontrol-1.3.4/sc.conf.pod000064400000000000000000000166021165425052100164430ustar00rootroot00000000000000#============================================================================= # FILE: sc.conf.pod # DESCRIPTION: Source for sc.conf(5) manpage # AUTHOR: Stanislav Kruchinin, #============================================================================= =head1 NAME B - configuration file for sc(8). =head1 DESCRIPTION The F is parsed using C module and has a simple C form. Expansion for internal and environment variables is enabled (see AppConfig(3) for details). The file may contain extra tabs and newlines for formatting. Comments begin with the B<#> character and end at the end of line, like in shell or Perl scripts. =head1 OPTIONS =over =item B, B and B Location of tc(8), iptables(8) and ipset(8) executables, respectively. =item B, B Names of interfaces that will be used for shaping of output and input traffic, respectively. =item B Traffic classification (filtering) method. Default value: u32. Possible values: =over 7 =item B Use B classifier and ipset(8) for access control. This method does not allow to use IPs with the same last two octets. =item B Use B hashing filters. This method allows IPs with the same last two octets, but prohibits the addresses with zero last octet due to limitations of tc(8) hashing filters syntax. =back =item B Rate limiting method. Default value: shaping. Possible values: B, B, B. Note, that B only works with B filtering method. B method uses shaping for download and policing for upload, and all the rules are created on the B interface. =item B Debug modes. Default value: 0. Possible values: =over =item B<0> no debug (default value), =item B<1> print command lines with nonzero return values, =item B<2> print all command lines without execution. =back =item B When enabled, turns on verbose messages and disables piping of tc(8) and ipset(8) rules. Default value: 0. Possible values: =over =item B<0> no verbose messages (default) =item B<1> enable verbose messages (i.e. for results of `sync' command) =item B<2> disable batch loading of rules for tc(8) and ipset(8) =item B<3> do B<1> + B<2> =back =item B Suppress output. Does not affect messages caused by C flag. Default value: 0. Possible values: boolean. =item B Colorize output using ANSI escape sequences. Autodetection of non-tty handles is supported. Default value: 1. Possible values: boolean. =item B Perform add, change and delete operation on rules and database by a single command. =item B If you use filter_method = flow, this variable defines the network for ipmap set. When filter_method = u32, it should contain the list of networks for classid calculation. This networks must cover all IPs which you are going to use in shaping rules. Default value: 172.16.0.0/16. Possible values: A single network with mask from 16 to 31 for B method. A list of networks with mask from 16 to 31 for B method. Total number of hosts in specified networks should not exceed the maximum number of child classes, e.g. 65534 (from 2 to ffff). =item B Network list for hashing filters generation. Makes sence only for B method. To improve the classification performance you may specify here a summarized network just like in case of supernetting (route aggregation). For example, if you have the following network configuration network = 10.0.0.0/20 10.0.253.0/24 10.0.254.0/24 you should specify a single 10.0.0.0/16 network to classify traffic by a single hashing filer filter_network = 10.0.0.0/16 Default value: same as B parameter. Possible values: a list of network with mask from 16 to 31 that is equivalent or includes the networks specified in B parameter. =item B Ratio between the size of policer buffer size and bandwidth rate. Default value: 0.1 =item B Amount of bytes a stream is allowed to dequeue before the next queue gets a turn. Default value: 1500. Possible values: integer numbers >= MTU of the interface. =item B Default rate unit. Default value: kibit. Possible values: see sc(8). =item B Ratio between bandwidth rates in rules and in the database. rule_rate = db_rate * rate_ratio This coefficient is used only for B and B commands. Default value: 1.0. Possible values: any rational number. =item B Leaf queueing discipline with parameters. This string will be used as a tail of corresponding C command line. Default value: C. Possible values: all classless qdiscs supported by tc(8). =item B Name of set with allowed IPs. Default value: pass. Possible values: ipset-accepted string. =item B Type of set. Default value: ipmap. Possible values: =over 8 =item B for IPs from one /16 network defined by C parameter (very fast and memory cheap) =item B for IPs from arbitrary /16 networks =back =item B Size of IP hash for ipset(8). Default value: 65536. Possible values: from 1024 to 65536. =item B Name of iptables(8) chain that will contain rules for shaped IPs. Default value: FORWARD. For names other than FORWARD the new chain will be created and attached to FORWARD chain. =item B Database host. Default value: 127.0.0.1. Possible values: IP-address or domain name. =item B Database driver. Default value: SQLite. Possible values: all database drivers supported by Perl DBI module. See output of C command for the list of available drivers. =item B Username to use when connecting to database. Default value: user. Possible values: depends on database server. =item B The password to use when connecting to database. Remember that specifying a password on the command line is insecure. Default value: password. Possible values: arbitrary string. =item B Database name to use. Default value: sc.db. Possible values: arbibrary string (should be a valid filename in case of SQLite driver). =item B Default values of queries are used for handling SQLite database F. List of queries: =over 16 =item B Create table with C and C columns. =item B Select all data from table. =item B Select data for one IP. =item B add new entry. =item B delete existing entry. =item B modify existing entry. =back =item B Output errors and warnings to syslog. Default value: 1. Possible values: boolean. =item B Syslog options. Default value: . Possible values (comma-separated): =over 12 =item B open the connection immediately =item B just emit warnings instead of dying if the connection to syslog can't be established =item B write the message to standard error output as well to the syslog =item B include PID with each message =back =item B syslog facility. Default value: user. Possible values: see Sys::Syslog(3), section C. =back =head1 SEE ALSO sc(8), tc(8), iptables(8), ipset(8), AppConfig(3), Sys::Syslog(3). =head1 AUTHOR Stanislav Kruchinin =cut # vim:set syntax=pod: shapercontrol-1.3.4/sc.init000075500000000000000000000020201165425052100156700ustar00rootroot00000000000000#!/bin/sh ### BEGIN INIT INFO # Provides: sc # Required-Start: $remote_fs $syslog # Required-Stop: $remote_fs $syslog # Default-Start: 2 3 4 5 # Default-Stop: 1 # Short-Description: Shaper Control Tool ### END INIT INFO set -e # /etc/init.d/sc: init script for Shaper Control Tool SC=/usr/local/sbin/sc test -x $SC || exit 0 if test -f /etc/default/sc; then . /etc/default/sc fi . /lib/lsb/init-functions if [ -n "$2" ]; then SC_OPTS="$SC_OPTS $2" fi case "$1" in start) log_daemon_msg "Starting shaper" "sc" if $SC $SC_OPTS load ; then log_end_msg 0 else log_end_msg 1 fi ;; stop) log_daemon_msg "Stopping shaper" "sc" if $SC $SC_OPTS reset ; then log_end_msg 0 else log_end_msg 1 fi ;; restart|reload|force-reload) log_daemon_msg "Restarting shaper" "sc" if $SC $SC_OPTS reload ; then log_end_msg 0 else log_end_msg 1 fi ;; status) $SC $SC_OPTS status ;; *) log_action_msg "Usage: /etc/init.d/sc {start|stop|reload|force-reload|restart|status}" exit 1 esac