Новичок
Профиль
Группа: Участник
Сообщений: 21
Регистрация: 7.3.2008
Репутация: нет
Всего: нет
|
Здравствуйте господа. ActivePerl 5.010 1004 Есть скрипт. Все вроде работает нормально, но с каждым подключением нового клиента пропадает по 4 Мб памяти. И после 32 подключений скрипт перестает отрабатывать. Грешу на не убитые треды, но найти где лажанулся не могу. Гляньте кому не лень. Заранее спасибо. | Код |
#!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use Devel::Leak::Object qw{ GLOBAL_bless };
use IO::Socket;
use Date::Calc qw(Today_and_Now);
use Win32::GUI();
use threads;
use threads::shared;
use Win32::HideConsole;
use Win32::GuiTest qw(:ALL);
use Thread::Cancel;
#===============================================================================
print "\n\n >>> Start Server <<< \n\n";
#===============================================================================
#hide_console; # Убрать консоль
eval{stop_vncserver();};
my $server_address = '127.0.0.1';
my @net = ( '127.0.0.1' , #
'192.168.0.1', #
'192.168.0.2', #
'192.168.0.3', #
'192.168.0.4', #
'192.168.0.5', #
'192.168.0.6', #
'192.168.0.7', #
'192.168.0.8', #
'192.168.0.9',
'192.168.0.10', #
'192.168.0.11', #
'192.168.0.12', #
'192.168.0.13', #
'192.168.0.14', #
'192.168.0.15', #
'192.168.0.16', #
'192.168.0.17', #
'192.168.0.18', #
'192.168.0.19', #
'192.168.0.20', #
'192.168.0.21', #
'192.168.0.22', ); #
my $count : shared = 0;
my $allow_host = '1';
my $sec = 300;
my ($t1_obj, $t2_obj, $main_obj, $lbl_obj, $pid, $peer_address);
my $oldcx = 0;
my $oldcy = 0;
$SIG{'KILL'} = sub { threads->exit(); };
my $thread1 = threads -> new(\&tcp_server,'');
$thread1 -> join();
#=== FUNCTION ================================================================
# NAME: tcp_server
# PURPOSE: purpose
# DESCRIPTION: describtion
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub tcp_server
{
use Thread::Cancel;
$SIG{'KILL'} = sub { threads->exit(); };
my $thread2;
my $tid;
my $socket = IO::Socket::INET->new( LocalAddr => $server_address,
LocalPort => 2222,
Proto => 'tcp',
Listen => 128,
Type => SOCK_STREAM ) || die "$!";
while (1) {
$socket->autoflush(1);
while ( my $session = $socket->accept() ) {
$peer_address = $session->peerhost();
my $message_in = <$session>;
$message_in = 'Stop' unless $message_in;
given($message_in) {
when(/^Start/) {
if (($count == 0) && ($peer_address ~~ @net)) {
stop_vncserver();
$thread2 = threads -> new(\&CreateWindow,'');
$tid = $thread2->tid();
$count++;
$allow_host = $peer_address;
print "Start session with $peer_address\n";
my $time_log = event_time();
write_to_log($time_log,"Start session $peer_address");
connect_to_vncclient($peer_address);
eval{send_udp_message('111')};
close $session;
} else {
print "Access_Denied for $peer_address\n";
my $time_log = event_time();
write_to_log($time_log,"Access_Denied for $peer_address");
send_udp_is_busy($peer_address);
close $session;
}
}
when(/^Stop/) {
if (($count == 1) && ($peer_address eq $allow_host) && ($peer_address ~~ @net)) {
stop_vncserver();
print "Stop session with $peer_address\n";
my $time_log = event_time();
write_to_log($time_log,"Stop session $peer_address");
eval{send_udp_message('222')};
$count = 0;
#threads->cancel($thread1);
threads->cancel($tid);
#$thread2->kill('KILL') -> detach();
}
}
default {
my $nothing = 1;
}
}
} # ----- end while -----
} # ----- end while -----
} # ---------- end of subroutine tcp_server ----------
sub send_udp_is_busy
{
my ($host) = @_;
my $socket_udp = IO::Socket::INET->new( PeerPort => 2222,
Proto => 'udp',
PeerAddr => "$host");
$socket_udp -> send('222');
close $socket_udp;
} # ---------- end of subroutine send_udp_is_busy ----------
#=== FUNCTION ================================================================
# NAME: connect_to_vncclient
# PURPOSE: purpose
# DESCRIPTION:
# PARAMETERS:
# RETURNS: return
#===============================================================================
sub connect_to_vncclient
{
use autodie;
my ($ip_of_client) = @_;
my $port = '::5500';
system(1,"C:\\PROGRA~1\\UltraVNC\\winvnc.exe -connect $ip_of_client$port -run");
} # ---------- end of subroutine connect_to_vncclient ----------
#=== FUNCTION ================================================================
# NAME: write_to_log
# PURPOSE: purpose
# DESCRIPTION: запись событий в лог файл
# PARAMETERS: Сообщение
# RETURNS: return
#===============================================================================
sub write_to_log
{
my ($time, $log_message) = @_;
my $OUTFILE_filename = 'log.txt'; # output file name
open ( OUTFILE, '>>', $OUTFILE_filename ) or die "$0 : failed to open output file $OUTFILE_filename : $!\n";
print OUTFILE "$time $log_message\n";
close ( OUTFILE ) or warn "$0 : failed to close output file $OUTFILE_filename : $!\n";
} # ---------- end of subroutine write_to_log ----------
#=== FUNCTION ================================================================
# NAME: send_udp_message
# PURPOSE: purpose
# DESCRIPTION: отправка сообщения на все машины в сети
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub send_udp_message
{
my ($udp_message) = @_;
foreach my $address ( @net ) {
my $socket_udp = IO::Socket::INET->new( PeerPort => 2222,
Proto => 'udp',
PeerAddr => "$address");
$socket_udp -> send($udp_message);
close $socket_udp;
} # ----- end foreach -----
} # ---------- end of subroutine send_udp_message ----------
#=== FUNCTION ================================================================
# NAME: time_log
# PURPOSE: purpose
# DESCRIPTION: Дата и время события
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub event_time
{
my ($year,$month,$day, $hour,$min,$sec) = Today_and_Now();
$month = sprintf("%02d", $month);
my $time = "$day".'-'."$month".'-'."$year"." "."$hour:$min:$sec";
return $time;
} # ---------- end of subroutine time_log ----------
#=== FUNCTION ================================================================
# NAME: CreateWindow
# PURPOSE: purpose
# DESCRIPTION: describtion
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub CreateWindow
{
my $desktop = Win32::GUI::GetDesktopWindow();
my $desktop_width = Win32::GUI::Width($desktop);
my $desktop_height = Win32::GUI::Height($desktop);
my $font = Win32::GUI::Font->new(
-name => "Arial",
-size => 24,
);
my $main = Win32::GUI::Window->new( -name => 'MainWin',
-size => [200,70],
-sysmenu => 0,
-pos => [$desktop_width/2,0],
-text => 'Осталось времени',);
$main_obj = shared_clone($main);
my $lbl1 = $main -> AddLabel( -name => 'Lbl1',
-align => 'center',
-text => " ",
-size => [200,70],
-pos => [0,0],
-font => $font,
-foreground => 0x0000FF,);
$lbl_obj = shared_clone($lbl1);
my $t1 = $main->AddTimer('T1', 300000);
$t1_obj = shared_clone($t1);
my $t2 = $main->AddTimer('T2', 1000);
$t2_obj = shared_clone($t2);
$main->Show();
Win32::GUI::Dialog();
} # ---------- end of subroutine CreateWindow ----------
#=== FUNCTION ================================================================
# NAME: MainWin_Terminate
# PURPOSE: purpose
# DESCRIPTION: describtion
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub MainWin_Terminate
{
-1;
} # ---------- end of subroutine MainWin_Terminate ----------
#=== FUNCTION ================================================================
# NAME: T1_Timer
# PURPOSE: purpose
# DESCRIPTION: describtion
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub T1_Timer
{
$t1_obj -> Kill();
$t2_obj -> Kill();
$main_obj -> Hide;
my $time_log = event_time();
write_to_log($time_log,"AutoStop session with $peer_address");
eval{send_udp_message('222')};
$count = 0;
stop_vncserver();
} # ---------- end of subroutine T1_Timer ----------
#=== FUNCTION ================================================================
# NAME: T2_Timer
# PURPOSE: purpose
# DESCRIPTION: describtion
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub T2_Timer
{
$sec--;
$lbl_obj -> Text("$sec сек");
} # ---------- end of subroutine T2_Timer ----------
#=== FUNCTION ================================================================
# NAME: stop_vncserver
# PURPOSE: purpose
# DESCRIPTION: Убиваем vnc-сервер
# PARAMETERS: params
# RETURNS: return
#===============================================================================
sub stop_vncserver
{
use autodie;
system(1,"C:\\PROGRA~1\\UltraVNC\\winvnc.exe -kill");
} # ---------- end of subroutine stop_vncserver ----------
1;
__END__;
|
|
threads - утечка памяти 
Загрузка ...
