Forum Debian Users Gang

#!/usr/bin/env perl
###################################################
# Konfiguracja
###################################################

use strict;
use warnings; 
use POSIX qw(floor);

my $wan_if = 'eth0'; # interfejs wpiety do internetu
my $max_upload = 1000; # maksymalny upload (teoretycznie 1Mbps)
my $max_download = 15000; # maksymalny download (teoretycznie 15Mbps)
my $srv_upload = 300; # Upload gwarantowany dla serwera
my $srv_download = 2000; # Download gwarantowany dla serwera
my $srv_prio = 4; # Priorytet serwera

# Tablica kompow w sieci
my @computers = (
#     IP  , priorytet, maksymalny przydzial pasma (w %)
[ "10.1.1.1", 4,   90 ],   # zuo
[ "10.1.1.10", 3, 100 ],   # moj desktop
[ "10.1.1.11", 2, 100 ],   # kodzio
[ "10.1.1.12", 0,  80 ],   # krzysiu ]:>
[ "10.1.1.13", 1, 100 ]    # kalamaje
);

###################################################
# Funkcje
###################################################
sub iptables
{
 my ($arg) = @_;
 return system('/sbin/iptables ' . $arg);
}

sub tc
{
 my ($arg) = @_;
 return system('/sbin/tc ' . $arg);
}

sub ip
{
 my ($arg) = @_;
 return system('/sbin/ip ' . $arg);
}

sub iptables_clear
{
 iptables('-t mangle -F');
 iptables('-t mangle -X'); 
}

sub tc_clear
{
 # jak nie ma kolejki bedzie niepotrzebnie plulo bledami
 tc('qdisc del dev imq0 root > /dev/null 2>&1');
 tc('qdisc del dev imq1 root > /dev/null 2>&1');
}

sub imq_clear
{
 ip('link set imq0 down');
 ip('link set imq1 down');
}

###################################################
# Glowny skrypt
###################################################

my $i;
# Przeliczamy ile sie nalezy lacza userowi gwarantowanego
my $user_download = floor(($max_download - $srv_download - 100) / $#computers);
my $user_upload = floor(($max_upload - $srv_upload - 100) / $#computers);

# Kasujemy stare ustawienia
iptables_clear;
tc_clear;
imq_clear;

print "User upload:   $user_upload\n";
print "User download: $user_download\n";

# Upload
ip("link set imq0 up"); # Podnosimy imq0 
tc("qdisc add dev imq0 root handle 1: htb default 10"); # Glowna kolejka na imq0

tc("class add dev imq0 parent 1: classid 1:1 htb rate ${max_upload}kbit ceil ${max_upload}kbit"); # Glowna klasa

tc("class add dev imq0 parent 1:1 classid 1:10 htb rate ${srv_upload}kbit ceil ${max_upload}kbit prio $srv_prio"); # Upload serwera idzie tutaj
tc("qdisc add dev imq0 parent 1:10 handle 10:0 sfq perturb 10"); # Sprawiedliwy podzial

for($i=0;$i<=$#computers;$i++)
{
 tc("class add dev imq0 parent 1:1 classid 1:2${i} htb rate ${user_upload}kbit ceil " . floor(($max_upload * $computers[$i][2]) / 100) . "kbit prio " . $computers[$i][1]); # Klasa dla miska
 tc("filter add dev imq0 parent 1: protocol ip prio 1 u32 match ip src " . $computers[$i][0] . " flowid 1:2${i}"); # Filtr dla miska
 tc("qdisc add dev imq0 parent 1:2${i} handle 2${i}:0 sfq perturb 10"); # Sprawiedliwy podzial
}

iptables("-t mangle -A POSTROUTING -o $wan_if -j IMQ --todev 0");

# Download
ip("link set imq1 up"); # Podnosimy imq1
tc("qdisc add dev imq1 root handle 1: htb default 10"); # Glowna kolejka na imq1

tc("class add dev imq1 parent 1: classid 1:1 htb rate ${max_download}kbit ceil ${max_download}kbit"); # Glowna klasa

tc("class add dev imq1 parent 1:1 classid 1:10 htb rate ${srv_download}kbit ceil ${max_download}kbit prio $srv_prio"); # Download serwera idzie tutaj
tc("qdisc add dev imq1 parent 1:10 handle 10:0 sfq perturb 10"); # Sprawiedliwy podzial

for($i=0;$i<=$#computers;$i++)
{
 tc("class add dev imq1 parent 1:1 classid 1:2${i} htb rate ${user_download}kbit ceil " . floor(($max_download * $computers[$i][2]) / 100) . "kbit burst 5k prio " . $computers[$i][1]); # Klasa dla miska
 tc("filter add dev imq1 parent 1: protocol ip prio 1 u32 match ip dst " . $computers[$i][0] . " flowid 1:2${i}"); # Filtr dla miska
 tc("qdisc add dev imq1 parent 1:2${i} handle 2${i}:0 sfq perturb 10"); # Sprawiedliwy podzial
}

iptables("-t mangle -A PREROUTING -i $wan_if -j IMQ --todev 1");