Скрипт не на BeanShell, а на Perl-е.
Код:
#!/usr/bin/perl
use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;
$debug = 1;
$port = 4445;
$ipfw = "/sbin/ipfw";
$rule_start = 35000;
#$pipe_start = 800;
$set = 10;
# База данных правил клиентов
%CLRULE = ();
%CLRULE_ID = ();
# База данных используемых номеров правил
%USERULEN = ();
%CLUSERULEN = ();
# База данных используемых номеров труб
%USEPIPEN = ();
%CLUSEPIPEN = ();
# Начать с пустыми буферами
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
# Прослушивать порт
$server = IO::Socket::INET->new( LocalPort => $port, Listen => 10 )
or die "Can`t make server socket: $@\n";
nonblock( $server );
$SIG{INT} = sub { $server->close(); exit( 0 ); };
$select = IO::Select->new( $server );
$pid = getpid();
open(FILE, ">/var/run/manad.pid");
print FILE $pid;
close(FILE);
# Устанавливаем новый root каталог для процесса
# chroot( $homedir ) or die "Couldn`t chroot to $homedir: $!\n";
# Главный цикл: проверка чтения/принятия, проверка записи,
# проверка готовности к работе
while( 1 )
{
my $client;
my $rv;
my $data;
# Проверить наличие новой информации на имеющихся подключениях
# Есть ли что-нибудь для чтения или подтверждения?
foreach $client ( $select->can_read( 1 ) )
{
if ( $client == $server )
{
# Принять новое подключение
$client = $server->accept();
$select->add( $client );
nonblock( $client );
}
else
{
# Прочитать данные
$data = '';
$rv = $client->recv( $data, POSIX::BUFSIZ, 0 );
unless( defined( $rv ) && length $data )
{
# Это должен быть конец файла, поэтому закрываем клиента
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove( $client );
close $client;
next;
}
$inbuffer{$client} .= $data;
# Проверить, говорят ли данные в буфере или только что прочитанные
# данные о наличии полного запроса, ожидающего выполнения. Если да -
# заполнить $ready{$client} запросами, ожидающими обработки.
while( $inbuffer{$client} =~ s/(.*\n)// ) { push( @{$ready{$client}}, $1 ) }
}
}
# Есть ли полные запросы для обработки?
foreach $client ( keys %ready ) { handle( $client ); }
# Сбрасываем буферы?
foreach $client ( $select->can_write( 1 ) )
{
# Пропустить этого слиента, если нам нечего сказать
next unless $outbuffer{$client};
block( $client );
$rv = $client->send( $outbuffer{$client}, 0 );
nonblock( $client );
unless( defined $rv )
{
# Пожаловаться, но следовать дальше
warn "I was told I could write? but I can`t.\n";
next;
}
if ( $rv == length $outbuffer{$client} || $! == POSIX::EWOULDBLOCK )
{
substr( $outbuffer{$client}, 0, $rv ) = '';
delete $outbuffer{$client} unless length $outbuffer{$client};
}
else
{
# Не удалось записать все данные и не из-за блокировки.
# Очистить буферы и следовать дальше.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($client);
close($client);
next;
}
}
}
# handle( $socket ) обрабатывает все необработанные запросы
# для клиента $client
sub handle
{
# Запрос находится в $ready{$client}
# Отправить вывод в $outbuffer{$client}
my $client = shift;
my $request;
foreach $request ( @{$ready{$client}} )
{
print "\nrequest=".$request if ( $debug == 1 );
if ( $request =~ /^testRID/ )
{
my $open_client = "";
foreach my $kod ( keys %CLRULE )
{ $open_client .= $open_client eq "" ? $kod : " ".$kod;
($CLRULE_ID{$kod} ne "")?$open_client.="-".$CLRULE_ID{$kod}:"";
}
$outbuffer{$client} .= $open_client."\n";
}
elsif ( $request =~ /^test/ )
{
my $open_client = "";
foreach my $kod ( keys %CLRULE )
{ $open_client .= $open_client eq "" ? $kod : " ".$kod;}
$outbuffer{$client} .= $open_client."\n";
}
elsif ( $request =~ /^add\t([0-9]+)\t(.*)/ )
{
my ($skip,$rid)=split /RULE/,$2;
print "\n=rule".$rid."\n" if ( $debug == 1 );
my ($kod, $rule) = ($1, $2);
&delete_rule( $kod ) if ( exists $CLRULE{$kod} );
&add_rule( $kod, $rule,$rid ) if ( !exists $CLRULE{$kod} );
}
elsif ( $request =~ /^remove\t([0-9]+)\t(.*)/ )
{
&delete_rule( $1,$2 ) if ( exists $CLRULE{$1} );
}
}
delete $ready{$client};
}
# nonblock( $socket ) переводит сокет в неблокирующий режим
sub nonblock
{
my $socket = shift;
my $flags;
$flags = fcntl( $socket, F_GETFL, 0 )
or die "Can`t get flags for socket: $!\n";
fcntl( $socket, F_SETFL, $flags | O_NONBLOCK )
or die "Can`t make socket nonblocking: $!\n";
}
sub block
{
my $socket = shift;
my $flags;
$flags = fcntl( $socket, F_GETFL, 0 )
or die "Can`t get flags for socket: $!\n";
fcntl( $socket, F_SETFL, $flags ^ O_NONBLOCK )
or die "Can`t make socket nonblocking: $!\n";
}
sub add_rule
{
my $kod = $_[0];
my $rule = $_[1];
my $rid = $_[2];
my %N = ();
my %P = ();
$CLRULE{$kod} = $rule;
$CLRULE_ID{$kod} = $rid;
while ( $rule =~ /\{N([AB0-9]+)\}/ )
{
my $n = $1;
my $i = $rule_start - 1;
my $j = 0;
while( 1 )
{
while( 1 )
{
$i++;
last if ( !exists $USERULEN{$i} );
}
$j++;
last if ( $j == $n );
last if ( $n == 0 );
}
$USERULEN{$i} = $kod;
$N{$n} = $i;
$rule =~ s/\{N$n\}/$N{$n}/g;
}
# while ( $rule =~ /\{P([AB0-9]+)\}/ )
# {
# my $p = $1;
# my $i = $pipe_start - 1;
# my $j = 0;
# while( 1 )
# {
# while( 1 )
# {
# $i++;
# last if ( !exists $USEPIPEN{$i} );
# }
# $j++;
# last if ( $j == $p );
# last if ( $p == 0 );
# }
# $USEPIPEN{$i} = $kod;
# $P{$p} = $i;
# $rule =~ s/\{P$p\}/$P{$p}/g;
# }
foreach my $i ( keys %N ) { $CLUSERULEN{$kod} .= exists $CLUSERULEN{$kod} && $CLUSERULEN{$kod} ne "" ? " ".$N{$i} : $N{$i}; }
# foreach my $i ( keys %P ) { $CLUSEPIPEN{$kod} .= exists $CLUSEPIPEN{$kod} && $CLUSEPIPEN{$kod} ne "" ? " ".$P{$i} : $P{$i}; }
# $rule =~ s/\|pipe/; \/sbin\/ipfw -q pipe /g;
$rule =~ s/\|table/; \/sbin\/ipfw -q table /g;
$rule =~ s/\|add ([0-9]+)/; \/sbin\/ipfw -q add $1 set $set /g;
# $rule =~ s/^pipe/\/sbin\/ipfw -q pipe /g;
$rule =~ s/^table/\/sbin\/ipfw -q table /g;
$rule =~ s/^add ([0-9]+)/\/sbin\/ipfw -q add $1 set $set /g;
$rule =~ s/\|/;/g;
# print "$ipfw -q $rule\n" if ( $debug == 1 );
# $err = `$ipfw -q $rule`;
print "$rule\n" if ( $debug == 1 );
$err = `$rule`;
}
sub delete_rule
{
my $kod = $_[0];
my $rule= $_[1];
if ( exists $CLRULE{$kod} )
{
$rule =~ s/\|table/; \/sbin\/ipfw -q table /g;
$rule =~ s/^table/\/sbin\/ipfw -q table /g;
$rule =~ s/\|/;/g;
# print "$ipfw -q $rule\n" if ( $debug == 1 );
# $err = `$ipfw -q $rule`;
print "$rule\n" if ( $debug == 1 );
$err = `$rule`;
my @N = split( / /, $CLUSERULEN{$kod} );
foreach my $i ( @N )
{
print "$ipfw delete $i\n" if ( $debug == 1 );
$err = `$ipfw delete $i`;
delete $USERULEN{$i};
}
my @P = split( / /, $CLUSEPIPEN{$kod} );
foreach my $i ( @P )
{
print "$ipfw pipe delete $i\n" if ( $debug == 1 );
# $err = `$ipfw pipe delete $i`;
# delete $USEPIPEN{$i};
}
delete $CLUSERULEN{$kod};
# delete $CLUSEPIPEN{$kod};
delete $CLRULE_ID{$kod};
delete $CLRULE{$kod};
}
}.
Скрипт был взят с этого форума, "переделанный под работу с табличками". Шейпер реализован другими методами, поэтому выкинут из скрипта. Такой же скрипт работает на другом шлюзе с freebsd, там проблем нет, но клиентов там на сейчас немного меньше. Этот скрипт тоже работал "как надо", проблемы начались после "перехода" какого-то количества клиентских записей, привязанных к шлюзу. Лично у меня сложилось такое ощущение, что не хватает каких-то буферов (может на прием на шлюзе, может на передачу, на сервере), - при запуске задачи "проверка шлюзов ipn" на "проблемном" шлюзе наблюдаю, что он начал обрабатывать запросы с сервера(БГ), но на каком-то этапе его "клинит"...
Вход
Регистрация
FAQ
Поиск
