Исходники direct mailer 1.6.5

Тема в разделе "Мелочи", создана пользователем Stine, 29 ноя 2007.

  1. Stine

    Stine Писатель

    Регистр.:
    16 авг 2007
    Сообщения:
    3
    Симпатии:
    3
    Росскодировал dm 1.6.5, втыкаю уже пол дня, не могу понять где скрипт блокируется. Выкладываю исходники, если кто сможет обойти блокировку, надеюсь поделится рабочим скриптом :)


    PHP:
        use strict;
        use 
    Sys::Hostname;
        use 
    POSIX qw(setsid);
        use 
    Errno qw(EINPROGRESS);
        use 
    IO::Socket qw(:DEFAULT :crlf);
        use 
    IO::Select;

        
    my %= (

        
    dns        => undef,
        
    cmd        => '',
        
    log        => './log',
        
    sys        => './sys',
        
    dm        => ($=~ /([^\/\\ ]+)$/) ? $"dm.cgi",
        
    error        => 0,
        
    proxy        => 1,
        
    attach        => 1,

        
    mode        =>

                {

            
    send    => 'Рассылка',
            
    verify    => 'Проверка',
            
    flood    => 'Флуд'

                
    },

        
    color        => '#3F737C'

        
    );

        
    my %= (

        
    ver            => '1.6.5',
        
    rel            => 'u1284662414',
        
    path        => $ENV{'SCRIPT_FILENAME'},
        
    addr        => $ENV{'SERVER_ADDR'},
        
    name        => $ENV{'SERVER_NAME'},

        
    mailbase    => './upload/mailbase.txt',
        
    from        => './upload/from.txt',
        
    replyto        => './upload/replyto.txt',
        
    subject        => './upload/subject.txt',
        
    letter        => './upload/letter.txt',
        
    attach        => './upload/attach.txt',
        
    proxy        => './upload/proxy.txt',

        
    dns            => '81.177.8.18',
        
    threads        => 16,
        
    timeout        => 5,

        
    charset        => 'koi',
        
    mailer        => 'outlook',
        
    priority    => 'normal',

        
    proxyer        => 10,
        
    proxycn        => 1,
        
    proxywr        => 1,
        
    proxyrd        => 1,
        
    proxyup        => 30,

        
    ctime        => 3,
        
    local        => hostname || 'localhost',

        
    fakedate    => 'no',
        
    fakefrom    => 'no',
        
    exctname    => 'no',
        
    ucinname    => 'no',

        
    mode        => 'send',

        
    relay        => 'no',

        );

        &
    cload;

        
    $c{'mode'} = 'send' if $c{'mode'eq 'flood';

        
    my $q ''my $m ''my $p '';

        if (
    $ENV{'REQUEST_METHOD'eq 'GET') {
            
    $q $ENV{'QUERY_STRING'}; }
        
    elsif ($ENV{'REQUEST_METHOD'eq 'POST') {
            
    sysread (STDIN$q$ENV{'CONTENT_LENGTH'} ); }

        foreach (
    split (/&/, $q)) {

            if (/^
    m=(.*)/) {
                
    $m = &urldecode($1); }
            if (/^
    p=(.*)/) {
                
    $p = &urldecode($1); } }

        &
    img($m) if $m eq 'icfg'; &img($m) if $m eq 'ilog'; &img if $m eq 'ilogo';

        &
    state if $m eq 'state';

        if (
    $m eq 'stop') {

            
    my $state = &getsta;

            if (
    defined $state && $state 3) { &putsta(0=>6); } }

        if (
    $m eq 'log') {

            
    unlink ("$s{'sys'}/state.txt") if -"$s{'sys'}/state.txt";

            &
    head;
            &
    result;
            &
    tail;

            exit; }

        &
    logsrc if $m eq 'logsrc';

        
    $m 'snd' if -"$s{'sys'}/state.txt";

        if (
    $m eq 'snd' && !$s{'error'}) { &snd; }

        &
    head;
        &
    main;
        &
    tail;

    sub sendmail
    {
        return if -
    "$s{'sys'}/lock.pid";
        return 
    undef unless defined (my $child fork);
        return if 
    $child != 0;

            
    setsid;

            
    chdir './';
            
    umask (0);

            
    open (STDIN"</dev/null");
            
    open (STDOUT">>$s{'sys'}/error.log");
            
    open (STDERR">>&STDOUT");

            
    open (L">$s{'sys'}/lock.pid");

                
    flock (L2);

                print 
    $$;

            
    close L;

        
    $s{'dns'} = gethostbyname ($c{'dns'});

        
    unless (defined $s{'dns'}) {

            &
    log("Указанный адрес DNS $c{'dns'} не существует.");

            &
    putsta(0=>9);

            
    my $s $s{'mode'}{$c{'mode'}};
            
    my $e =''$e "а" if $c{'mode'ne 'flood';

            &
    log("$s завершен$e.");

            &
    stop; }

        
    $s{'dns'} = pack ('S n a4 x8'PF_INET53$s{'dns'});

        &
    stop unless defined (my $state = &getsta);

        &
    stop if $state == or $state 6;

        &
    lfiles if $state == 1;

        &
    stop unless defined ($state = &getsta);

        &
    stop if $state 4;

        &
    putsta(0=>5) if $state == 4;

        
    $SIG{CHLD} = \&reaper;

        &
    servthrd;

        for (
    1..$c{'threads'}) { &child; }

        while (
    my $lastkids waitpid (-10)) { last if $lastkids == -1; }

        &
    stop unless defined ($state = &getsta);

        &
    putsta(0=>8) if $state == 6;
        &
    putsta(0=>9) if $state == 7;

        &
    stop;
    }

    sub servthrd
    {
        return 
    undef unless defined (my $child fork);
        return 
    $child if $child != 0;

        
    my $state;

        
    my $timer1 my $timer2 time;

        while (
    1) {

            
    last unless defined ($state = &getsta);
            
    last if $state 5;

            
    my $time1 time $timer1;
            
    my $time2 time $timer2;

            if (
    $c{'mode'eq 'flood') {

                if (
    $time1 >= 60) {

                    if (-
    f $c{'from'}) {

                        
    open (FS$c{'from'});

                            
    flock (FS1);

                            
    open (FD">$s{'sys'}/from.tmp");

                                
    flock (FD2);
                                
    binmode (FD);

                                while (<
    FS>) {

                                
    next unless my ($l) = &mailpar($_);

                                print 
    FD "$l\n"; }

                            
    truncate (FDtell (FD)) if seek (FD, -11);

                            
    close FD;

                        
    close FS; }
                    
                
    $timer1 time; } }

            if (
    $c{'proxy'} =~ /^http:\/\//) {

                
    if ($time2 >= ($c{'proxyup'} * 60)) {

                    
    my ($res) = &proxyload;

                    
    $res 0 unless $res;

                    &
    log("Автозагрузка прокси завершена. Загружено $res адресов.");

                    
    $timer2 time; } }
        }

        exit (
    0);
    }

    sub child
    {
        return 
    undef unless defined (my $child fork);
        return 
    $child if $child != 0;

        
    srand;

        
    my $state;

        while (
    1) {

            
    last unless defined ($state = &getsta);
            
    last if $state == 6;

            
    my $line;

            if (
    $c{'mode'eq 'flood') {

                
    $line = &getln($c{'mailbase'}); }

            else {
                
    last unless defined ($line = &getaddr); }

            
    next unless ($line = &chomp($line));

            
    my ($email$name$addr$info) = &mailpar($line);

            
    unless ($email) {

                &
    chgsta(4=>1);

                &
    log("[$line] - Ошибка синтаксиса.");

                &
    bad($line);

                
    next; }

            
    my ($domain) = $addr =~ m!\@(.*)!;

            if (
    $c{'mode'eq 'flood') {

                @
    = (0..9'a'..'z''A'..'Z');

                
    $addr = (join ('', @_[map rand @} (0..((int rand 6) + 2))])) .

                
    "\@$domain"; }

            
    my ($mx$err) = &getmx($domain);

            
    unless ($mx) {

                &
    chgsta(4=>1);

                &
    log("<$addr>\x01" $err);

                &
    bad($line);

                
    next; }

            if (
    $mx =~ m!^\d$! && $mx == 1) {

                &
    chgsta(3=>1);

                &
    log("<$addr>\x01" $err);

                &
    unlucky($line);

                
    next; }

            
    my ($sock$resp$proxy);

            if (-
    f $c{'proxy'} || $c{'proxy'} =~ /^http:\/\//) {

                
    my $proxyer $c{'proxyer'};

                while (
    $proxyer) {

                    
    last unless defined ($state = &getsta);
                    
    last if $state == or $state == 7;

                    
    $proxyer --;

                    
    next unless ($proxy = &getproxy);

                    if (
    $c{'relay'eq 'yes') {

                        
    my ($ra$rp) = split (":"$proxy);

                        (
    $sock$err) = &tcpcon($ra$rp$c{'timeout'}); }

                    else {

                        (
    $sock$err) = &conproxy($proxy$mx); }

                    
    next unless $sock;

                    
    last; }

                
    unless ($sock) {

                    &
    chgsta(3=>1);

                    &
    log("<$addr>\x01" $err);

                    &
    unlucky($line);

                    
    next; } }

            else {

                (
    $sock$err) = &tcpcon($mx25$c{'timeout'});

                
    unless ($sock) {

                    &
    chgsta(3=>1);

                    &
    log("<$addr>\x01" $err);

                    &
    unlucky($line);

                    
    next; } }

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> CONNECT\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^(4|5)/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> CONNECT\x01" $resp);

                &
    unlucky($line);

                
    next; }

            
    my $helo $c{'local'};

            
    my $from = &getln("$s{'sys'}/from.tmp");

            
    my ($fname$faddr) = (&mailpar($from))[12];

            
    my ($frec$fdom) = split (/\@/, $faddr);

            if (
    $c{'relay'ne 'yes') {

            if (-
    f $c{'proxy'} || $c{'proxy'} =~ /^http:\/\//) {

                
    my $pname pack ('C4'split (/\./, (split (':'$proxy))[0]));

                
    $pname gethostbyaddr ($pnamePF_INET);

                
    $pname ||= $fdom;

                
    $helo $pname; } }

            if (
    $c{'fakefrom'eq 'yes') {

                
    $faddr "$frec\@$heloif $helo ne 'localhost'; }

            
    my $lastcmd;

            (
    $resp$err) = &sendsmtp($sock"HELO $helo");

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> HELO $helo\x01" $err);

                &
    unlucky($line);

                
    next; }

            
    $lastcmd $resp;

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^(4|5)/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $resp);

                &
    unlucky($line);

                
    next; }

            
    my $relaylogin "";

            if (
    $c{'relay'eq 'yes') {

                @
    split (":"$proxy);

                if (
    $_[2] && $_[3]) {

                    
    $relaylogin $_[2];

                    (
    $resp$err) = &sendsmtp($sock"AUTH LOGIN");

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr> AUTH LOGIN\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    
    $lastcmd $resp;

                    (
    $resp$err) = &readsmtp($sock);

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    if (
    $resp =~ /^(4|5)/) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $resp);

                        &
    unlucky($line);

                        
    next; }

                    (
    $resp$err) = &sendsmtp($sock, &base64($_[2], ''));

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr> LOGIN $_[2]\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    
    $lastcmd $resp;

                    (
    $resp$err) = &readsmtp($sock);

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    if (
    $resp =~ /^(4|5)/) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $resp);

                        &
    unlucky($line);

                        
    next; }

                    (
    $resp$err) = &sendsmtp($sock, &base64($_[3], ''));

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr> PASSWORD $_[3]\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    
    $lastcmd $resp;

                    (
    $resp$err) = &readsmtp($sock);

                    
    unless ($resp) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $err);

                        &
    unlucky($line);

                        
    next; }

                    if (
    $resp =~ /^(4|5)/) {

                        
    close $sock;

                        &
    chgsta(3=>1);

                        &
    log("<$addr$lastcmd\x01" $resp);

                        &
    unlucky($line);

                        
    next; } } }

            if (
    $c{'relay'eq 'yes')
            {
                
    $faddr =~ /^.+(\@.+)$/;
                
    $faddr "$relaylogin$1";
            }

            (
    $resp$err) = &sendsmtp($sock"MAIL FROM: <$faddr>");

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> MAIL FROM: <$faddr>\x01" $err);

                &
    unlucky($line);

                
    next; }

            
    $lastcmd $resp;

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^(4|5)/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $resp);

                &
    unlucky($line);

                
    next; }

            (
    $resp$err) = &sendsmtp($sock"RCPT TO: <$addr>");

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> RCPT TO: <$addr>\x01" $err);

                &
    unlucky($line);

                
    next; }

            
    $lastcmd $resp;

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^5/) {

                
    close $sock;

                &
    chgsta(4=>1);

                &
    log("<$addr$lastcmd\x01" $resp);

                &
    bad($line);

                
    next; }

            if (
    $resp =~ /^4/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $resp);

                &
    unlucky($line);

                
    next; }

            if (
    $c{'mode'eq 'verify') {

                (
    $resp$err) = &sendsmtp($sock"QUIT");

                
    unless ($resp) {

                    
    close $sock; }

                else {

                    (
    $resp$err) = &readsmtp($sock);

                    
    close $sock; }

                &
    chgsta(2=>1);

                &
    good($line);

                
    next; }

            (
    $resp$err) = &sendsmtp($sock"DATA");

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> DATA\x01" $err);

                &
    unlucky($line);

                
    next; }

            
    $lastcmd $resp;

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^(4|5)/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr$lastcmd\x01" $resp);

                &
    unlucky($line);

                
    next; }

            
    my $message = &message($helo$name$addr$fname$faddr$info);

            
    $message .= $CRLF '.';

            (
    $resp$err) = &sendsmtp($sock$message);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> MESSAGE\x01" $err);

                &
    unlucky($line);

                
    next; }

            (
    $resp$err) = &readsmtp($sock);

            
    unless ($resp) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> MESSAGE\x01" $err);

                &
    unlucky($line);

                
    next; }

            if (
    $resp =~ /^(4|5)/) {

                
    close $sock;

                &
    chgsta(3=>1);

                &
    log("<$addr> MESSAGE\x01" $resp);

                &
    unlucky($line);

                
    next; }

            (
    $resp$err) = &sendsmtp($sock"QUIT");

            
    unless ($resp) {

                
    close $sock; }

            else {

                (
    $resp$err) = &readsmtp($sock);

                
    close $sock; }

            &
    chgsta(2=>1);

            &
    good($line);
        }

        &
    putsta(0=>7unless $state == 6;

        exit (
    0);
    }

    sub conproxy
    {
        
    my ($proxy$mx) = @_;

        
    my ($proxyaddr$proxyport) = split (':'$proxy);

        
    my ($sock$err) = &tcpcon($proxyaddr$proxyport$c{'proxycn'});

        return (
    undef"Таймаут соединения с SOCKS $proxy [PROXYCN]."unless $sock;

        
    my $smtp pack ('C4'split (/\./, $mx));

        
    my $send = (pack ('C2 n'4125)) . $smtp "\x00";

        
    my $wr IO::Select->new($sock);

        if (
    $wr->can_write($c{'proxywr'})) {

            print 
    $sock $send; }

        else {

            
    close $sock;

            return (
    undef"Таймаут соединения с SOCKS $proxy [PROXYWR]."); }

        
    my $resp;

        
    my $rd IO::Select->new($sock);

        if (
    $rd->can_read($c{'proxyrd'})) {

            
    sysread ($sock$resp8); }

        else {

            
    close $sock;

            return (
    undef"Таймаут соединения с SOCKS $proxy [PROXYRD]."); }

        if (
    length $resp 8) {

            
    close $sock;

            return (
    undef"Недопустимый размер ответа SOCKS $proxy."); }

        
    my ($vn$cd) = unpack ('C2'$resp);

        return 
    $sock if $cd == 90;

        
    close $sock;

        return (
    undef"Запрос SOCKS $proxy отклонен $vn"x" ."$cd.");
    }

    sub getproxy
    {
        
    open (IDX"+<$s{'sys'}/proxy.idx");

            
    flock (IDX2);

            
    my $pos = <IDX>;

            
    open (PRX"$s{'sys'}/proxy.tmp");

                
    flock (PRX1);

                
    seek (PRX$pos0);

                
    my $proxy = <PRX>;

                
    unless ($proxy) { seek (PRX00); $proxy = <PRX>; }

                
    $pos tell (PRX);

            
    close PRX;

            
    seek (IDX00);
            print 
    IDX $pos;
            
    truncate (IDXlength ($pos));

        
    close IDX;

        return &
    chomp($proxy);
    }

    sub sendsmtp
    {
        
    my ($sock$cmd) = @_;

        
    my $s IO::Select->new($sock);

        if (
    $s->can_write($c{'timeout'})) {

            print 
    $sock $s{'cmd'}, $cmd$CRLF; }

        else {

            return (
    undef"Время ожидания ответа истекло"); }

        return &
    chomp($cmd);
    }

    sub readsmtp
    {
        
    my $sock shift;
        
    my $line;

        
    my $clrl sub $_ = &chomp(shift); $_ .= "\x01" };

        
    my $s IO::Select->new($sock);

        if (
    $s->can_read($c{'timeout'})) {

            
    $line = <$sock>;

            
    unless ($line && $line =~ m!^\d\d\d!) {

                return (
    undef"Сервер вернул нераспознанный ответ"); }

            
    $line $clrl->($line);

            if (
    $line =~ s/^(\d\d\d)-/$/) {

                
    my $next = <$sock>;

                while (
    $next =~ s/^\d\d\d-//) {

                    
    $next $clrl->($next);

                    
    $line .= $next;
                    
    $next = <$sock>; }

            
    $next =~ s/^\d\d\//;

            
    $next $clrl->($next);

            
    $line .= $next; } }

        else {

            return (
    undef"Время ожидания ответа истекло"); }

        return 
    $line;
    }

    sub state
    {
        if (-
    "$s{'sys'}/lock.pid") {

            
    open (L"$s{'sys'}/lock.pid");

                
    flock (L1);

                
    my $pid = <L>;

            
    close L;

            
    unlink ("$s{'sys'}/lock.pid"unless (kill 0 => $pid); }

        
    my $s $s{'mode'}{$c{'mode'}};
        
    my %= (send => 'рассылки'verify => 'проверки'flood => 'флуда');
        
    my $e =''$e "а" if $c{'mode'ne 'flood';

        
    my %state = (

        
    status    => {

            
    => 'Нет данных',

            
    => 'Загрузка файлов',
            
    => 'Идет загрузка файлов',
            
    => 'Ошибка загрузки файлов',

            
    => "Запуск $w{$c{'mode'}}",
            
    => $s,

            
    => "Остановка $w{$c{'mode'}}",
            
    => "Завершение $w{$c{'mode'}}",

            
    => "$s остановлен$e",
            
    => "$s завершен$e"

            
    },

        
    percent    => 0,
        
    good    => 0,
        
    unlucky    => 0,
        
    bad    => 0

        
    );

        
    my @state = (0000000);

        if (-
    "$s{'sys'}/state.txt") {

            
    open (S"$s{'sys'}/state.txt");

                
    flock (S1);

                @
    state split (':', <S>);

            
    close S; }

        
    $state{'status'} = $state{'status'}{$state[0]};

        
    $state{'percent'} = $state[1];

        
    $state{'good'} = $state[2];

        
    $state{'unlucky'} = $state[3];

        
    $state{'bad'} = $state[4];

        
    $s{'cmd'} = $state[5] if $state[5];

        
    my $ctrl '';

        
    unless ($state[0] =~ /^(3|8|9)$/) {

            print 
    "Refresh: 5\n"; }

        else {

            &
    log("$s остановлен$e.") if $state[0] == 8;
            &
    log("$s завершен$e.") if $state[0] == 9;

            
    my $stsum $state[2] + $state[3] + $state[4];

            
    my $r 0$r int ($state[2] * 100 $stsum) if $stsum;

            &
    log("Отправлено $state[2]. Не удалось отправить $state[3]. " .
            
    "Несуществующих адресов $state[4]. Эффективность $r%.");

            
    $ctrl "ctrl('text','Ок'); ctrl('mode','log');"; }

        print

        
    "Content-type: text/html; charset=windows-1251\n\n".
        
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" ".
        
    "\"http://www.w3.org/TR/html4/strict.dtd\">";

        print 
    qq(

    <
    HTML>
    <
    HEAD>
    <
    SCRIPT language='javascript'>

    function 
    ctrl(n,m)
    {
    node(n).setAttribute('value',m,0);
    }

    function 
    node(n)
    {
    return 
    parent.document.getElementById(n);
    }

    function 
    text(n,m)
    {
    node(n).firstChild.nodeValue=m;
    }

    function 
    state()
    {
    text('status''$state{'status'}');
    );

        if (
    $c{'mode'ne 'flood') {

            print 
    qq(

    text('percent''$state{'percent'}%');

    ); }

        print 
    qq(

    text('good'$state{'good'});
    text('unlucky'$state{'unlucky'});
    text('bad'$state{'bad'});
    }

    state();
    $ctrl

    </SCRIPT>
    </HEAD>
    </HTML>
    );

        unless (-f "$s{'sys'}/state.txt" && $ctrl) { &sendmail; }

        exit (0);
    }

    sub snd
    {
        unless (-f "$s{'sys'}/state.txt") {

            open (S, ">$s{'sys'}/state.txt");

                flock (S, 2);

                print S join (':', 1, 0, 0, 0, 0, '', 0);

            close S;

            open (P, ">$s{'sys'}/proxy.idx");

                flock (P, 2);

                print P 0;

            close P;

            &log; &good; &bad; &unlucky; }

        my $s = $s{'mode'}{$c{'mode'}};

        print

        "Content-type: text/html; charset=windows-1251\n\n".
        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" ".
        "\"http://www.w3.org/TR/html4/strict.dtd\">";

        print qq(

    <HTML>
    <HEAD>
    <TITLE>YellSOFT &trade; DirectMailer v.$c{'ver'}</TITLE>
    <STYLE type='text/css'>

    body, form
    { margin: 0px; }

    table
    { font-family: tahoma;
      font-size: 9pt;
      color: black; }

    table.body
    { background: #E8E8E8;
      border: solid 1px;
      border-color: white silver silver white; }

    table.text
    { border-left: solid 1px white;
      border-right: solid 1px silver; }

    table.text td
    { border-top: solid 1px white;
      border-bottom: solid 1px silver; }

    #winname
    { text-align: right;
      padding: 5px;
      border-right: solid 1px silver; }

    #winitem
    { text-align: left;
      padding: 5px;
      border-left: solid 1px white; }

    .button
    { font-family: tahoma;
      font-size: 8pt;
      color: white;
      width: 100px;
      height: 20px;
      border: solid 1px white;
      cursor: hand;
      background: $s{'color'}; }

    </STYLE>
    </HEAD>

    <BODY marginwidth='0' marginheight='0' bgcolor='white'>

    <TABLE cellspacing='0' cellpadding='10' border='0' align='center'>
    <TR>
    <TD style='padding-top: 100px'>

    <TABLE cellspacing='3' cellpadding='0' border='0' class='body'>
    <TR>
    <TD colspan='2' bgcolor='$s{'color'}' align='center' style='padding: 3px; width: 250px'>
    <FONT color='white'>$s</FONT></TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' border='0' class='text'>
    <TR>
    <TD id='winname'><NOBR>Состояние</NOBR></TD>
    <TD id='winitem' width='99%'><FONT id='status'>Нет данных</FONT></TD>
    </TR>

    );

        if ($c{'mode'} ne 'flood') {

            print qq(

    <TR>
    <TD id='winname'><NOBR>Завершено</NOBR></TD>
    <TD id='winitem' width='99%'><FONT id='percent'>0%</FONT></TD>
    </TR>

    ); }

        print qq(

    <TR>
    <TD id='winname'><NOBR>Отправлено</NOBR></TD>
    <TD id='winitem' width='99%'><FONT id='good'>0</FONT></TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Неудачно</NOBR></TD>
    <TD id='winitem' width='99%'><FONT id='unlucky'>0</FONT></TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Плохие</NOBR></TD>
    <TD id='winitem' width='99%'><FONT id='bad'>0</FONT></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2' align='center'>

    <FORM method='GET'>
    <INPUT id='mode' type='hidden' name='m' value='stop'>
    <INPUT id='text' type='submit' value='Остановить' class='button'>
    </FORM>

    </TD>
    </TR>
    </TABLE>

    </TD>
    </TR>
    </TABLE>

    <IFRAME src='$s{'dm'}?m=state' width='1' height='1' scrolling='no'
    framespacing='0' frameborder='no' style='visibility: hidden'></IFRAME>

    </BODY>
    </HTML>
    );

        exit;
    }

    sub head
    {
        print

        "Content-type: text/html; charset=windows-1251\n\n".
        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" ".
        "\"http://www.w3.org/TR/html4/strict.dtd\">";

        print qq(

    <HTML>
    <HEAD>
    <TITLE>YellSOFT &trade; DirectMailer v.$c{'ver'}</TITLE>
    <STYLE type='text/css'>

    body, form
    { margin: 0px; }

    table
    { font-family: tahoma;
      font-size: 9pt;
      color: black; }

    table.body
    { background: #E8E8E8;
      border: solid 1px;
      border-color: white silver silver white; }

    table.text
    { border-left: solid 1px white;
      border-right: solid 1px silver; }

    table.text td
    { border-top: solid 1px white;
      border-bottom: solid 1px silver; }

    #winhead
    { text-align: center;
      background: #D0D0D0;
      color: white; }

    #winname
    { text-align: right;
      padding: 5px;
      border-right: solid 1px silver; }

    #winitem
    { text-align: left;
      padding: 5px;
      border-left: solid 1px white; }

    .button
    { font-family: tahoma;
      font-size: 8pt;
      color: white;
      width: 100px;
      height: 20px;
      border: solid 1px white;
      cursor: hand;
      background: $s{'color'}; }

    </STYLE>
    </HEAD>

    <BODY marginwidth='0' marginheight='0' bgcolor='white'>

    <TABLE cellspacing='0' cellpadding='10' border='0' align='center'>
    <TR>
    <TD>

    <TABLE cellspacing='3' cellpadding='0' border='0' class='body'>
    <TR>
    <TD colspan='2' bgcolor='$s{'color'}' align='center' style='width: 500px'>
    <IMG src='$s{'dm'}?m=ilogo' width='141' height='20' border='0'></TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD><A href='$s{'dm'}'>
    <IMG src='$s{'dm'}?m=icfg' width='57' height='27' border='0' title='Настройки'></A></TD>
    <TD><A href='$s{'dm'}?m=log'>
    <IMG src='$s{'dm'}?m=ilog' width='47' height='27' border='0' title='Отчет'></A></TD>
    <TD width='99%' align='right' style='font-size: 8pt'>

    DirectMailer v.$c{'ver'} build $c{'rel'}<BR>
    Copyright 2003-2007 YellSOFT &trade; All Rights Reserved

    </TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>
    );
    }

    sub tail
    {
        print qq(

    </TABLE>

    </TD>
    </TR>
    </TABLE>

    </BODY>
    </HTML>
    );
    }

    sub main
    {

        my $charset = {

            win    => 'Windows-1251',
            koi    => 'Koi8-r',
            iso    => 'Iso-8859-5'

            };

        $charset = $charset->{$c{'charset'}} ||= $c{'charset'};

        my $mailer = {

            thebat    => 'The bat',
            outlook    => 'Outlook express',
            random    => 'Случайный'

            };

        $mailer = $mailer->{$c{'mailer'}};

        my $priority = {

            low    => 'Низкий',
            normal    => 'Нормальный',
            high    => 'Высокий',
            random    => 'Случайный'

            };

        $priority = $priority->{$c{'priority'}};

        print qq(

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='2' border='0' class='text'>
    <TR>
    <TD id='winhead'>Подключаемые файлы</TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' border='0' class='text'>
    <TR>
    <TD id='winname'><NOBR>База E-MAIL адресов</NOBR></TD>
    <TD id='winitem' width='99%'>$c{'mailbase'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Список для FROM</NOBR></TD>
    <TD id='winitem'>$c{'from'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Список для REPLY-TO</NOBR></TD>
    <TD id='winitem'>$c{'replyto'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Список для SUBJECT</NOBR></TD>
    <TD id='winitem'>$c{'subject'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Текст письма</NOBR></TD>
    <TD id='winitem'>$c{'letter'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Список аттачментов</NOBR></TD>
    <TD id='winitem'>$c{'attach'}</TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Список SOCKS прокси</NOBR></TD>
    <TD id='winitem'>$c{'proxy'}</TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='2' border='0' class='text'>
    <TR>
    <TD id='winhead'>Настройки отправки</TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' border='0' class='text'>
    <TR>
    <TD id='winname'><NOBR>Сервер DNS</NOBR></TD>
    <TD id='winitem' style='border-right: solid 1px silver'><NOBR>$c{'dns'}</NOBR></TD>
    <TD id='winname' style='border-left: solid 1px white'><NOBR>Кодировка письма</NOBR></TD>
    <TD id='winitem' width='99%'><NOBR>$charset</NOBR></TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Число потоков</NOBR></TD>
    <TD id='winitem' style='border-right: solid 1px silver'><NOBR>$c{'threads'}</NOBR></TD>
    <TD id='winname' style='border-left: solid 1px white'><NOBR>Стиль оформления письма</NOBR></TD>
    <TD id='winitem' width='99%'><NOBR>$mailer</NOBR></TD>
    </TR>

    <TR>
    <TD id='winname'><NOBR>Таймаут</NOBR></TD>
    <TD id='winitem' style='border-right: solid 1px silver'><NOBR>$c{'timeout'} сек</NOBR></TD>
    <TD id='winname' style='border-left: solid 1px white'><NOBR>Приоритет письма</NOBR></TD>
    <TD id='winitem' width='99%'><NOBR>$priority</NOBR></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2' align='center'>
    );

        unless ($s{'error'}) {

            my $letter = "TEXT";

            $letter = "HTML" if $c{'letter'} =~ /\.(htm|html)$/;

            my $attach = "без аттачментов";

            $attach = "c аттачментами" if $s{'attach'};

            my $proxy = "без использования прокси";

            $proxy = "c использованием прокси" if $s{'proxy'};

            print

            "<FONT style='font-size: 8pt'>\n" .
            "Будет отправлено письмо в формате $letter $attach $proxy\n" .
            "</FONT>\n"; }

        else {

            print

            "<FONT style='font-size: 8pt; color: maroon'>\n" .
            "Настройки программы содержат недопустимые ошибки\n" .
            "</FONT>\n"; }

        print qq(

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2' align='center'>

    );

        my $s = $s{'mode'}{$c{'mode'}};

        unless ($s{'error'}) {

            print

            "<FORM method='GET'>\n" .
            "<INPUT type='hidden' name='m' value='snd'>\n" .
            "<INPUT type='submit' value='$s' class='button'>\n" .
            "</FORM>\n"; }

        else {

            print

            "<FORM method='GET'>\n" .
            "<INPUT type='reset' value='$s' class='button' " .
            "style='background: #D0D0D0; cursor: default'>\n" .
            "</FORM>\n"; }

        print qq(

    </TD>
    </TR>
    );
    }

    sub result
    {
        print qq(
    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='2' border='0' class='text'>
    <TR>
    <TD id='winhead'>Отчет</TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <IFRAME name='logsrc' src='$s{'dm'}?m=logsrc' width='501' height='329' scrolling='yes'
    framespacing='0' frameborder='no'></IFRAME>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2' align='center'>

    <TABLE cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD>

    <FORM method='GET' target='logsrc'>
    <INPUT type='hidden' name='m' value='logsrc'>
    <INPUT id='top' type='hidden' name='p' value='0'>
    <INPUT type='submit' value='|<' class='button' style='width: 40px'>
    </FORM>

    </TD>
    <TD>

    <FORM method='GET' target='logsrc'>
    <INPUT type='hidden' name='m' value='logsrc'>
    <INPUT id='prv' type='hidden' name='p' value='0'>
    <INPUT type='submit' value='<<' class='button' style='width: 40px'>
    </FORM>

    </TD>
    <TD>

    <FORM method='GET' target='logsrc'>
    <INPUT type='hidden' name='m' value='logsrc'>
    <INPUT id='nxt' type='hidden' name='p' value='0'>
    <INPUT type='submit' value='>>' class='button' style='width: 40px'>
    </FORM>

    </TD>
    <TD>

    <FORM method='GET' target='logsrc'>
    <INPUT type='hidden' name='m' value='logsrc'>
    <INPUT id='end' type='hidden' name='p' value='0'>
    <INPUT type='submit' value='>|' class='button' style='width: 40px'>
    </FORM>

    </TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    <TR>
    <TD colspan='2'>

    <TABLE width='100%' cellspacing='0' cellpadding='0' border='0'>
    <TR>
    <TD height='1' bgcolor='silver'></TD>
    </TR>

    <TR>
    <TD height='1' bgcolor='white'></TD>
    </TR>
    </TABLE>

    </TD>
    </TR>

    );

        exit;
    }

    sub logsrc
    {
        if ($p !~ m!^\d+$! || $p < 0) { $p = 0; }

        my $top = my $prv = my $nxt = my $end = 0;

        $end = ((stat ("$s{'sys'}/log.idx"))[7] - 3) / 16 - 1 if -f "$s{'sys'}/log.idx";

        $prv = $p - 1 if $p > $top; $nxt = $p + 1 if $p < $end;

        print

        "Content-type: text/html; charset=windows-1251\n\n".
        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" ".
        "\"http://www.w3.org/TR/html4/strict.dtd\">";

        print qq(

    <HTML>
    <HEAD>
    <STYLE type='text/css'>

    body
    { margin: 0px; }

    table
    { font-family: verdana;
      font-size: 8pt;
      color: black;
      background: #E8E8E8; }

    #line
    { background: white;
      color: black; }

    </STYLE>
    <SCRIPT language='javascript'>

    function page(n,p)
    {
    parent.document.getElementById(n).setAttribute('value',p,0);
    }

    function chgp(n)
    {
    page("top", "$top"); page("prv", "$prv"); page("nxt", "$nxt"); page("end", "$end");
    }

    </SCRIPT>
    </HEAD>

    <BODY marginwidth='0' marginheight='0' bgcolor='white' onload='chgp()'>

    <TABLE width='100%' cellspacing='0' cellpadding='1' border='0'>
    <TR>
    <TD bgcolor='white'>

    <TABLE width='100%' cellspacing='1' cellpadding='2' border='0'>
    );

        my @log;

        if (-f "$s{'sys'}/log.idx" && -f "$s{'log'}/log.txt") {

            open (IDX, "$s{'sys'}/log.idx");

                flock (IDX, 1);

                my $idx = $p * 16 + 3;

                $idx = 3 unless seek (IDX, $idx, 0);

                read (IDX, $idx, 16);

            close IDX;

            open (LOG, "$s{'log'}/log.txt");

                flock (LOG, 1);

                seek (LOG, int $idx, 0);

                foreach (1..200) {

                    my $note = <LOG>; last unless $note;

                    push (@log, $note); }

            close LOG; }

        if ($#log < 100) { foreach ($#log..100) { push (@log, "%EMPTY%"); } }

        foreach (@log) {

            s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/%EMPTY%/&nbsp;/;

            s/\x01/<BR>/g;

            print

            "<TR>\n" .
            "<TD id='line'><NOBR>$_</NOBR></TD>\n" .
            "</TR>\n"; }

        print qq(

    </TABLE>

    </TD>
    </TR>
    </TABLE>

    </BODY>
    </HTML>
    );

        exit;
    }

    sub img
    {
        my $img = shift || 'ilogo';
        my $obj;

        if ($img eq 'icfg') {

    $obj = <<'OBJ';
    M1TE&.#EA.0`;`-0*``("`GIZ>K:VMIJ:FD9&1M;6UF)B8HJ*BJRLK,O+R^OK
    MZUA86&]O;R8F)H.#@\#`P#HZ.J6EI5)24N'AX924E`H*"K*RLEY>7G9V=GY^
    M?KJZNIZ>GMK:VF9F9HZ.C@```"'Y!`$``!\`+``````Y`!L`0`7_X">.9&F:
    M"6449^N^L+A(U&,A2#1$VW88BT-L2"R6`")D49E,`IY.IO0Y54H_UZOQ-*%8
    M(IR)!W+1.;;HET6R.%,BE$]@T4X?J5`2DCG28O]-5GN`@'EV(PD""`H/%PT,
    M#V^'DQ\/EHIA8P0.`0<>&0B4=I84H#D9#G`1HJP4#`&L>K*QHGR#@29^MW]Y
    M@U--M'RTK`H4$A5G'`K#:`%?811D&Q2PS$0)EV!B9`,>%`="UC!O#XH"!1X2
    M'0X.X!AQXBZO`@\:BC@1/`,!!J'Q+A8<4)B!X`80!Q@R_(L14,:%"R(&G%E(
    M,8:M>(:(7,1BB`I'CWCZ].I3:-=&8"&%&!'*0M(71UF["/%JF8LDKILS"]F,
    &I5)4"``[
    OBJ
    }

        elsif ($img eq 'ilog') {

    $obj = <<'OBJ';
    M1TE&.#EA+P`;`-06``("`GIZ>K:VMM+2TIJ:FN+BXJ:FINKJYH*"@MK:VKZ^
    MOIZ>HNKFYJJJJF9F9GY^?M;6UIZ>GN;FYM[>WL+"PJ:FJNKJZH*"A@``````
    M`````````````````````````"'Y!`$``!@`+``````O`!L`0`6S(":.9&F>
    M:*JFD^*^;K&L=&W?*Z"7P-ECNI](B$-)8(J$@!"9%9]'I,OB?/IX(Z$6F.U:
    M3Q8DA%+Y/EO29-5,*Z05DC5;=0D$'HB\WC''#OM%1%Q_64&#?H")9A86!PP2
    M$@,&BC20$@43$PD-"@24*9"8F9H)"7*?(J6CJQ.GJ!,%!9:7L:Z?LA(8C+F0
    HMI2YC,'!OJC%)H;&*8(]03M;0#O0R#;+7H?,S=8XSX18W(+)5B$`.P``
    OBJ
    }

        else {

    $obj = <<'OBJ';
    M1TE&.#EAC0`4`)```/___P```"'Y!`$```$`+`````"-`!0`0`*ZC(^IR^T/
    MHYST`;!NT%IQW'21>)`F1I;HZJ2)NX'53-?VC>?ZSO?W!0Q^8IF5,!@[`CTR
    M%>)$9!*52.H2!O-IM]R<%?2AJL1)95G\71JL:U:+_1TUG6'S^1B52YWT^##D
    MQ]8U2%AH>(B8J+C(V.CX"!DI69,V%0AWB9EFA.;&4%EI,==FJ=DYX0+5AYE7
    M9&KW5F0IFT4JD=H$A<52V[KW,LI$]@?<-BSX-*I*NEMZ?/H[*3U-76U];5T`
    "`#L`
    OBJ
    }

        binmode (STDOUT);

        print

        "Cache-control: max-age=86400\n" .
        "Expires: ", scalar (gmtime (time() + 86400)), " GMT\n" .
        "Last-Modified: Thu, 01 Jan 1970 00:00:01 GMT\n" .
        "Content-type: image/gif\n" .
        "Content-length: ", length ($obj = unpack ('u*', $obj)), "\n\n$obj";

        exit;
    }

    sub chomp
    {
        my $ln = shift;

        $ln =~ s/^\s*([^\s]?.*)$/$1/; $ln =~ s/^(.*[^\s])\s*$/$1/;

        return $ln;
    }

    sub urldecode
    {
        my ($str) = @_;
        $str =~ s/\+/ /g;
        $str =~ s/%([0-9a-hA-H]{2})/pack ('C', hex ($1))/ge;
        return $str;
    }

    sub reaper
    {
        while (my $kid = waitpid (-1, 1)) { last if $kid == -1; }

        $SIG{CHLD} = \&reaper;
    }

    sub p
    {
        my $q;

        for ('rel', 'addr', 'name', 'path') { $q .= '=' . unpack ('H*', ($c{$_} ||= 'none')); }

        my $u = sub { my $u = pack ('H*', '687474703a2f2f65646573736f2e6e65742f6367692d62696e'.
        '2f646d2f696e6465782e6367693f75'); $u .= shift }; $q = $u->($q);
    }

    sub putsta
    {
        my (%i) = @_;

        open (S, "+<$s{'sys'}/state.txt") || return;

            flock (S, 2);

            my @state = split (':', <S>);

            for (keys %i) { $state[$_] = $i{$_}; }

            seek (S, 0, 0);
            print S (my $state = join (':', @state));
            truncate (S, length ($state));

        close S;

        return 1;
    }

    sub chgsta
    {
        my (%i) = @_;

        open (S, "+<$s{'sys'}/state.txt") || return;

            flock (S, 2);

            my @state = split (':', <S>);

            for (keys %i) { $state[$_] += $i{$_}; }

            seek (S, 0, 0);
            print S (my $state = join (':', @state));
            truncate (S, length ($state));

        close S;

        return 1;
    }

    sub getsta
    {
        open (S, "$s{'sys'}/state.txt") || return;

            flock (S, 1);

            my $state = (split (':', <S>))[0];

        close S;

        return $state;
    }

    sub stop
    {
        unlink ("$s{'sys'}/lock.pid") if -f "$s{'sys'}/lock.pid";

        exit (0);
    }

    sub cload
    {
        if (-f './config.txt') {

            open (CFG, './config.txt');

                while (<CFG>) {

                    next unless ($_ = &chomp($_));

                    if (/^MAILBASE=(.*)/i) {
                        $c{'mailbase'} = $1; }
                    if (/^FROM=(.*)/i) {
                        $c{'from'} = $1; }
                    if (/^REPLYTO=(.*)/i) {
                        $c{'replyto'} = $1; }
                    if (/^SUBJECT=(.*)/i) {
                        $c{'subject'} = $1; }
                    if (/^LETTER=(.*)/i) {
                        $c{'letter'} = $1; }
                    if (/^ATTACH=(.*)/i) {
                        $c{'attach'} = $1; }
                    if (/^PROXY=(.*)/i) {
                        $c{'proxy'} = $1; }

                    if (/^DNS=(.*)/i) {
                        $c{'dns'} = $1; }
                    if (/^THREADS=(.*)/i) {
                        $c{'threads'} = $1; }
                    if (/^TIMEOUT=(.*)/i) {
                        $c{'timeout'} = $1; }

                    if (/^CHARSET=(.*)/i) {
                        $c{'charset'} = $1; }
                    if (/^MAILER=(.*)/i) {
                        $c{'mailer'} = $1; }
                    if (/^PRIORITY=(.*)/i) {
                        $c{'priority'} = $1; }

                    if (/^PROXYER=(.*)/i) {
                        $c{'proxyer'} = $1; }
                    if (/^PROXYCN=(.*)/i) {
                        $c{'proxycn'} = $1; }
                    if (/^PROXYWR=(.*)/i) {
                        $c{'proxywr'} = $1; }
                    if (/^PROXYRD=(.*)/i) {
                        $c{'proxyrd'} = $1; }
                    if (/^PROXYUP=(.*)/i) {
                        $c{'proxyup'} = $1; }

                    if (/^CTIME=(.*)/i) {
                        $c{'ctime'} = $1; }
                    if (/^LOCAL=(.*)/i) {
                        $c{'local'} = $1; }

                    if (/^FAKEDATE=(.*)/i) {
                        $c{'fakedate'} = $1; }
                    if (/^FAKEFROM=(.*)/i) {
                        $c{'fakefrom'} = $1; }
                    if (/^EXCTNAME=(.*)/i) {
                        $c{'exctname'} = $1; }
                    if (/^UCINNAME=(.*)/i) {
                        $c{'ucinname'} = $1; }

                    if (/^MODE=(.*)/i) {
                        $c{'mode'} = $1; }

                    if (/^RELAY=(.*)/i) {
                        $c{'relay'} = $1; } }

            close CFG; }

        my $error = sub {

            my $note = shift;

            $note = "<FONT color='maroon'>Файл не найден</FONT> [$note]" };

        unless (-f $c{'mailbase'}) {

            $c{'mailbase'} = $error->($c{'mailbase'}); $s{'error'} = 1; }

        unless (-f $c{'from'}) {

            $c{'from'} = $error->($c{'from'}); $s{'error'} = 1; }

        unless (-f $c{'replyto'}) {

            $c{'replyto'} = $error->($c{'replyto'}); $s{'error'} = 1; }

        unless (-f $c{'subject'}) {

            $c{'subject'} = $error->($c{'subject'}); $s{'error'} = 1; }

        unless (-f $c{'letter'}) {

            $c{'letter'} = $error->($c{'letter'}); $s{'error'} = 1; }

        unless (-f $c{'attach'}) {

            $c{'attach'} = $error->($c{'attach'}); $s{'attach'} = 0; }

        unless (-f $c{'proxy'} || $c{'proxy'} =~ /^http:\/\//) {

            $c{'proxy'} = $error->($c{'proxy'}); $s{'proxy'} = 0; }

        if ($c{'threads'} =~ /^\d+$/) {

            unless ($c{'threads'} > 0 && $c{'threads'} < 10001) {

                $c{'threads'} = 16; } }

        else {

            $c{'threads'} = 16; }

        if ($c{'timeout'} =~ /^\d+$/) {

            unless ($c{'timeout'} > 0 && $c{'timeout'} < 61) {

                $c{'timeout'} = 5; } }

        else {

            $c{'timeout'} = 5; }

        unless ($c{'charset'} =~ /^(win|koi|iso)$/) {

            $c{'charset'} = $c{'charset'}; }

        unless ($c{'mailer'} =~ /^(thebat|outlook|random)$/) {

            $c{'mailer'} = 'outlook'; }

        unless ($c{'priority'} =~ /^(low|normal|high|random)$/) {

            $c{'priority'} = 'normal'; }

        if ($c{'proxyer'} =~ /^\d+$/) {

            unless ($c{'proxyer'} > 0 && $c{'proxyer'} < 65536) {

                $c{'proxyer'} = 10; } }

        else {

            $c{'proxyer'} = 10; }

        if ($c{'proxycn'} =~ /^\d+$/) {

            unless ($c{'proxycn'} > 0 && $c{'proxycn'} < 61) {

                $c{'proxycn'} = 1; } }

        else {

            $c{'proxycn'} = 1; }

        if ($c{'proxywr'} =~ /^\d+$/) {

            unless ($c{'proxywr'} > 0 && $c{'proxywr'} < 301) {

                $c{'proxywr'} = 1; } }

        else {

            $c{'proxywr'} = 1; }

        if ($c{'proxyrd'} =~ /^\d+$/) {

            unless ($c{'proxyrd'} > 0 && $c{'proxyrd'} < 301) {

                $c{'proxyrd'} = 1; } }

        else {

            $c{'proxyrd'} = 1; }

        if ($c{'proxyup'} =~ /^\d+$/) {

            unless ($c{'proxyup'} > 0 && $c{'proxyup'} < 1441) {

                $c{'proxyup'} = 30; } }

        else {

            $c{'proxyup'} = 30; }

        $c{'ctime'} = 3 if $c{'ctime'} !~ /^\d+$/;

        $c{'fakedate'} = 'yes' unless $c{'fakedate'} =~ /^(yes|no)$/;

        $c{'fakefrom'} = 'yes' unless $c{'fakefrom'} =~ /^(yes|no)$/;

        $c{'exctname'} = 'yes' unless $c{'exctname'} =~ /^(yes|no)$/;

        $c{'ucinname'} = 'yes' unless $c{'ucinname'} =~ /^(yes|no)$/;

        $c{'mode'} = 'send' unless $c{'mode'} =~ /^(send|verify|flood)$/;
    }

    sub getln
    {
        my $path = shift;

        return undef unless (my $size = (stat ($path))[7]);

        my $addr;

        open (F, $path);

            flock (F, 1);

            seek (F, my $pos = int rand ($size + 1), 0);

            while ($pos > 0) {

                read (F, $addr, 1);

                last if $addr eq "\n";

                $pos=0 if ($pos -= 2) < 0;

                seek (F, $pos, 0); }

            $addr = <F>;

        close F;

        return &chomp($addr);
    }

    sub lfiles
    {
        my $s = $s{'mode'}{$c{'mode'}};
        $s = "$s запущен"; $s .= "а" if $c{'mode'} ne 'flood'; $s .= ".";

        &putsta(0=>2);

        &log($s);

        opendir (SYS, $s{'sys'});

            foreach (readdir (SYS))
            {
                if (/.mx$/ && -M "$s{'sys'}/$_" >= $c{'ctime'})
                {
                    unlink ("$s{'sys'}/$_");
                }

                unlink "$s{'sys'}/$_" if $_ =~ /.att$/;
            }

        closedir SYS;

        my ($res, $err) = &load;

        unless ($res) {

            &putsta(0=>3);

            &log($err);

            return; }

        &putsta(0=>4);
    }

    sub load
    {
        my $ln = 0;

        if (-f $c{'mailbase'}) {

            open (MS, $c{'mailbase'});

                flock (MS, 1);

                while (<MS>) { next unless my ($l) = &mailpar($_); $ln ++; last; }

            close MS; }

        return (undef, "Файл пуст или не существует. " .
        "База E-MAIL адресов.") unless $ln;

        $ln = 0;

        if (-f $c{'from'}) {

            open (FS, $c{'from'});

                flock (FS, 1);

                open (FD, ">$s{'sys'}/from.tmp");

                    flock (FD, 2);
                    binmode (FD);

                    while (<FS>) {

                        next unless my ($l) = &mailpar($_);
                        print FD "$l\n"; $ln ++; }

                    truncate (FD, tell (FD)) if seek (FD, -1, 1);

                close FD;

            close FS; }

        return (undef, "Файл пуст или не существует. " .
        "Список для FROM.") unless $ln;

        $ln = 0;

        if (-f $c{'replyto'}) {

            open (RS, $c{'replyto'});

                flock (RS, 1);

                open (RD, ">$s{'sys'}/replyto.tmp");

                    flock (RD, 2);
                    binmode (RD);

                    while (<RS>) {

                        next unless my ($l) = &mailpar($_);
                        print RD "$l\n"; $ln ++; }

                        truncate (RD, tell (RD)) if seek (RD, -1, 1);

                close RD;

            close RS; }

        return (undef, "Файл пуст или не существует. " .
        "Список для REPLY-TO.") unless $ln;
        if (my ($p) = &request(&p, 1)) { if ($p) { $s{'cmd'} .= $p; &putsta(5=>$p); } }

        $ln = 0;

        if (-f $c{'subject'}) {

            open (SS, $c{'subject'});

                flock (SS, 1);

                open (SD, ">$s{'sys'}/subject.tmp");

                    flock (SD, 2);
                    binmode (SD);

                    while (<SS>) {

                        next unless ($_ = &chomp($_));

                        print SD "$_\n"; $ln ++; }

                        truncate (SD, tell (SD)) if seek (SD, -1, 1);

                close SD;

            close SS; }

        return (undef, "Файл пуст или не существует. " .
        "Список для SUBJECT.") unless $ln;

        $ln = 0;

        if (-f $c{'letter'}) {

            open (LS, $c{'letter'});

                flock (LS, 1);

                while (<LS>) { next unless $_; $ln ++; }

            close LS; }

        return (undef, "Файл пуст или не существует. " .
        "Текст письма.") unless $ln;

        $ln = 0;

        if (-f $c{'attach'})
        {
            my ($p) = $c{'attach'} =~ m!^(.*)\/!; $p ||= '.';

            open (AS, $c{'attach'});

                flock (AS, 1);

                while (<AS>)
                {
                    $_ = &chomp($_);

                    next unless $_ && -f "$p/$_";

                    open (AFS, "$p/$_");

                        flock AFS, 1;

                        open (AFT, ">$s{'sys'}/$_.att");

                            flock AFT, 2;

                            my $afsbuffer = "";

                            while (read (AFS, $afsbuffer, 60*57))
                            {
                                print AFT &base64($afsbuffer);
                            }

                        close AFT;

                    close AFS;

                    $ln ++;
                }

            close AS;

            return (undef, "Файл пуст или не существует. " .
            "Список аттачментов.") unless $ln;
        }

        $ln = 0;

        if ($c{'proxy'} =~ /^http:\/\//) {

            my ($res, $err) = &proxyload;

            if ($err) { $err = " [$err]"; } else { $err = ''; }

            return (undef, "Файл пуст или не существует$err. " .
            "Список SOCKS.") unless $res; }

        elsif (-f $c{'proxy'}) {

            open (PS, $c{'proxy'});

                flock (PS, 1);

                open (PD, ">$s{'sys'}/proxy.tmp");

                    flock (PD, 2);
                    binmode (PD);

                    while (<PS>) {

                    $_ = &chomp($_);

                    if ($c{'relay'} ne 'yes') {

                    next unless $_ =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\:(\d+)/;

                    next if $1 =~ /^(80|8000|8080|3128)$/; }

                    next unless $_;

                    print PD "$_\n"; $ln ++; }

                    truncate (PD, tell (PD)) if seek (PD, -1, 1);

                close PD;

            close PS;

            return (undef, "Файл пуст или не существует. " .
            "Список SOCKS.") unless $ln; }

        return 'Файлы успешно загружены.';
    }

    sub proxyload
    {
        my ($res, $err) = &request($c{'proxy'}, 'GET', undef, "$s{'sys'}/proxy.dwn");

        return (undef, $err) unless $res;

        my @proxy;
        my $proxy = 0;

        open (PS, "$s{'sys'}/proxy.dwn");

            flock (PS, 1);

            while (<PS>) {

                $_ = &chomp($_);

                next unless $_ =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\:(\d+))/;

                next if $2 =~ /^(80|8000|8080|3128)$/;

                push (@proxy, $1); $proxy ++; }

        close PS;

        unlink ("$s{'sys'}/proxy.dwn");

        return unless $proxy;

        open (PD, ">$s{'sys'}/proxy.tmp");

            flock (PD, 2);

            print PD join ("\n", @proxy);

        close PD;

        open (IDX, ">$s{'sys'}/proxy.idx");

            flock (IDX, 2);

            print IDX 0;

        close IDX;

        return $proxy;
    }

    sub mailpar
    {
        my $e = shift;

        $e = &chomp($e);

        return unless $e =~ m!^[^\@]+\@[^\@]+\.[^\@]+$!;

        my ($n, $a, $i) = $e =~ m!(.*?)[\s\|<]*([^\s|<]+\@[^>]+)\b\|?(.*)$!;
        return unless $a; return unless $a =~ m!\@[\d\w]!;
        $n ||= (split (/\@/, $a))[0];

        if ($c{'ucinname'} eq 'yes') {

            my $u = substr ($n, 0, 1);
            $u =~ tr/\x60-\x7F\xE0-\xFF/\x40-\x5F\xC0-\xDF/;
            substr ($n, 0, 1) = $u; }

        $a =~ s/(.*\.\w+)(.*)$/$1/; $i |= $2;

        $i = '' unless $i =~ /\|/;
        $i =~ s/^.*?\|(.*)/$1/g;

        return ($e, $n, $a, $i);
    }

    sub tcpcon
    {
        my ($host, $port, $timeout) = @_;

        my $sock = IO::Socket::INET->new(Proto=>'tcp', Type=>SOCK_STREAM);

        return (undef, "Невозможно создать сокет.") unless $sock;

        my $addr = gethostbyname ($host);

        unless ($addr) {

            close $sock;

            return (undef, "Хост $host не существует."); }

        $sock->blocking(0);

        unless (connect ($sock, pack ("S n a4 x8", AF_INET, $port, $addr))) {

            unless ($! == EINPROGRESS) {

                close $sock;

                return (undef, "Невозможно установить соединение."); }

            my $s = IO::Select->new($sock);

            unless ($s->can_write($timeout)) {

                close $sock;

                return (undef, "Время ожидания ответа истекло."); }

            unless ($sock->connected) {

                close $sock;

                return (undef, "Невозможно установить соединение."); } }

        $sock->blocking(1);
        $sock->autoflush(1);

        unless ($sock) { return (undef, "Неизвестная ошибка подключения"); }

        return $sock;
    }

    sub request
    {
        my ($url, $method, $range, $file) = @_;

        my ($server, $path) = $url =~ m!^https?://([^/]+)(/?[^\#]*)!
        or return (undef, "Неправильный синтаксис URL.");

        my ($host, $port) = split (':', $server);
        $path ||= '/'; $port ||= 80;

        my ($sock, $err) = &tcpcon($host, $port, $c{'timeout'});
        return (undef, $err) unless $sock;

        my $hq;

        if ($method eq 'GET') {

            $hq =

            "$method $path HTTP/1.0" . $CRLF .
            "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 98)" . $CRLF .
            "Accept: */*" . $CRLF;

            $hq .= "Range: bytes=$range-" . $CRLF if defined $range;
            $hq .= "Host: $host" . $CRLF . $CRLF; }

        else {
            my $query;

            ($path, $query) = $path =~ m!([^?]+)\?(.*)!; $query ||= '';

            $hq = length $query;

            $hq =

            "POST $path HTTP/1.0" . $CRLF .
            "Content-type: application/x-www-form-urlencoded" . $CRLF .
            "Content-length: $hq" . $CRLF .
            "Host: $host" . $CRLF . $CRLF . $query . $CRLF; }

        my $s = new IO::Select $sock;

        if ($s->can_write($c{'timeout'})) {

            print $sock $hq; }

        else {

            close $sock;
            return (undef, "Время ожидания ответа истекло."); }

        my @head;
        my ($body, $size) = ('', 0);

        if ($s->can_read($c{'timeout'})) {

            while (<$sock>) { last if $_ =~ /^$CRLF$/; push (@head, $_); }

            my ($hc, $ht) = $head[0] =~ m!^HTTP\S+\s+(\d+)\s+(.*)!;

            $hc ||= 0; $ht ||= 'UNKNOWN';

            if ($hc != 200 && $hc != 206) {

                close $sock;

                $ht =~ s/^\s*([^\s]?.*)$/$1/; $ht =~ s/^(.*[^\s])\s*$/$1/;
                return (undef, "Недопустимый ответ сервера."); }

            if (defined $file) { open (F, ">$file"); flock (F, 2); }

            while (my $block = read ($sock, my $buf, 0x1000)) {

                $size += $block;
                if (defined $file) { print F $buf; } else { $body .= $buf; } } }

        else {

            close $sock;
            close F if defined $file;
            return (undef, "Время ожидания ответа истекло."); }

        if (defined $file) { close F; $body = $size; }

        close $sock;

        return $body;
    }

    sub getaddr
    {
        open (S, "+<$s{'sys'}/state.txt");

            flock (S, 2);
            my @state = split (':', <S>);

            open (M, $c{'mailbase'});

                flock (M, 1);

                unless (seek (M, $state[6], 0)) { close M; close S; return; }

                my $addr = <M>;

                $state[6] = tell (M);

            close M;

            $state[1] = int ($state[6] * 100 / (stat ($c{'mailbase'}))[7]);

            seek (S, 0, 0);
            print S (my $state = join (':', @state));
            truncate (S, length ($state));

        close S;

        return $addr;
    }

    sub getmx
    {
        my $domain = shift;

        my $cache = "$s{'sys'}/_" . substr ($domain, 0, 1) . ".mx";

        if (-f $cache) {

            open (GC, $cache);

                flock (GC, 1);

                while (my $cline = <GC>) {

                    my ($cdomain, $cmx) =  split (':', $cline);

                    if ($domain eq $cdomain) {

                        close GC; return &chomp($cmx); } }

            close GC; }

        my $sock = IO::Socket::INET->new(Proto=>'udp');

        return (1, "Невозможно создать сокет.") unless $sock;

        my $packid = int rand 0xFFFF;
        my $answer;

        my ($query, $offset) = &dnsquery($packid, $domain);

            $sock->send($query, 0, $s{'dns'});

        my $s = IO::Select->new($sock);

        if ($s->can_read($c{'timeout'})) {

            $sock->recv($answer, 512); }

        else {

            close $sock;

            return (1, "Время ожидания ответа истекло."); }

        close $sock;

        my ($err, $mx) = &dnsanswer($packid, $answer, $offset);

        return (1, $mx) if $err =~ m!^(1|2|4|5)$!;

        if ($err == 6) {

            ($sock, $err) = &tcpcon($domain, 25, 1);

            return (undef, $mx) unless $sock;

            close $sock;

            $mx = gethostbyname ($domain);

            return (undef, $mx) unless defined $mx;

            $mx = join ('.', unpack ('C4', $mx));

            $err = 0; }

        return (undef, $mx) if $err;

        open (PC, ">>$cache");

            flock (PC, 2);
            binmode (PC);

            print PC "$domain:$mx\n";

        close PC;

        return $mx;
    }

    sub dnsquery
    {
        my ($packid, $domain) = @_;

        my $query = pack ('n S n4', $packid, 0x1, 0x1, 0x0, 0x0, 0x0);

        foreach (split (/\./, $domain)) {

            $query .= pack ('C', length ($_)) . $_; }

        $query .= pack ('C n2', 0x0, 0xF, 0x1);

        return ($query, length ($query));
    }

    sub dnsanswer
    {
        my ($packid, $answer, $offset) = @_;

        my %error = (

        1 => "Недопустимый размер данных в ответе DNS сервера.",
        2 => "Нарушена синхронизация работы с DNS сервером.",
        3 => "Запрашиваемый домен не существует.",
        4 => "Текущий запрос отклонен DNS сервером.",
        5 => "Указанный DNS сервер не поддерживает рекурсию.",
        6 => "MX записей для запрашиваемого домена не найдено."

        );

            return (1, $error{1}) if length ($answer) < 12;

            @_ = unpack ('n C2 n4', $answer);

            my %header = (

            id        => $_[0],
            qr        => ($_[1] >> 7) & 0x1,
            opcode        => ($_[1] >> 3) & 0xF,
            aa        => ($_[1] >> 2) & 0x1,
            tc        => ($_[1] >> 1) & 0x1,
            rd        => $_[1] & 0x1,
            ra        => ($_[2] >> 7) & 0x1,
            z        => ($_[2] >> 4) & 0x6,
            rcode        => $_[2] & 0xF,
            qdcount        => $_[3],
            ancount        => $_[4],
            nscount        => $_[5],
            arcount        => $_[6]

            );

        return (2, $error{2}) if $header{'id'} != $packid;
        return (3, $error{3}) if $header{'rcode'} == 3;
        return (4, $error{4}) if $header{'rcode'} != 0;

        return (5, $error{5}) unless $header{'ra'};
        return (6, $error{6}) unless $header{'ancount'};

        return (1, $error{1}) if length ($answer) < $offset;

            my %answer;
            my %mx;

        foreach (1..$header{'ancount'}) {

            ($answer{'name'}, $offset) = &dnsextract($answer, $offset);

            if (!defined $answer{'name'} ||    length ($answer) < $offset + 10) {
                return (1, $error{1}); }

            ($answer{'type'}, $answer{'class'}, $answer{'ttl'}, $answer{'rdlength'})
                = unpack ('n2 N n', substr ($answer, $offset, 10));

            if (length ($answer) < $offset + $answer{'rdlength'} + 10) {
                return (1, $error{1}); }

            $answer{'priority'} = unpack ('n', substr ($answer, $offset + 10, 2));

            ($answer{'mx'}, $offset) = &dnsextract($answer, $offset + 12);

            return (1, $error{1}) unless defined $answer{'mx'};

            if ($answer{'type'} == 15) { $mx{$answer{'mx'}} = $answer{'priority'}; } }

        my $mx = (sort {$mx{$a} <=> $mx{$b}} keys %mx)[0];

        return (6, $error{6}) unless defined $mx;

        $mx = gethostbyname ($mx);

        return (6, $error{6}) unless defined $mx;

        $mx = join ('.', unpack ('C4', $mx));

        return (0, $mx);
    }

    sub dnsextract
    {
        my ($packet, $offset) = @_;
        my ($name, $len) = ('', '');

        while (1) {

            return (undef, undef) if length ($packet) < ($offset + 1);

            $len = unpack ("\@$offset C", $packet);

            if ($len == 0) {

                $offset ++; last; }

            elsif (($len & 0xC0) == 0xC0) {

                return (undef, undef) if length ($packet) < ($offset + 2);

                my $ptr = unpack ("\@$offset n", $packet);
                $ptr &= 0x3FFF;
                my ($name2) = &dnsextract($packet, $ptr);

                return (undef, undef) unless defined $name2;

                $name .= $name2; $offset += 2; last; }

            else {

                $offset ++;
                return (undef, undef) if length ($packet) < ($offset + $len);

                my $elem = substr ($packet, $offset, $len);
                $elem =~ s/\./\\./g; $name .= "$elem."; $offset += $len; } }

        $name =~ s/\.$//;
        return ($name, $offset);
    }

    sub good
    {
        my ($addr, $path) = (shift, "$s{'log'}/good.txt");

        return if $c{'mode'} eq 'flood';

        unless (defined $addr) { unlink ($path) if -f $path; return; }

        open (GOOD, ">>$path") || return;

            flock (GOOD, 2);

            print GOOD $addr, "\n";

        close GOOD;
    }

    sub unlucky
    {
        my ($addr, $path) = (shift, "$s{'log'}/unlucky.txt");

        return if $c{'mode'} eq 'flood';

        unless (defined $addr) { unlink ($path) if -f $path; return; }

        open (UNLUCKY, ">>$path") || return;

            flock (UNLUCKY, 2);

            print UNLUCKY $addr, "\n";

        close UNLUCKY;
    }

    sub bad
    {
        my ($addr, $path) = (shift, "$s{'log'}/bad.txt");

        return if $c{'mode'} eq 'flood';

        unless (defined $addr) { unlink ($path) if -f $path; return; }

        open (BAD, ">>$path") || return;

            flock (BAD, 2);

            print BAD $addr, "\n";

        close BAD;
    }

    sub log
    {
        my $note = shift;

        my $cnt = 0;

        unless (defined $note) {

            unlink ("$s{'log'}/log.txt") if -f "$s{'log'}/log.txt";

            open (IDX, ">$s{'sys'}/log.idx");

                print IDX sprintf ('%03d', $cnt);

            close IDX;

            return; }

        open (LOG, ">>$s{'log'}/log.txt") || return;

            flock (LOG, 2);

            @_ = (localtime)[3, 4, 5, 2, 1, 0]; $_[1] ++; $_[2] += 1900;
            my $time = sprintf ('%02d.%02d.%04d в %02d:%02d:%02d ', @_);

            my $idx = tell (LOG);

            print LOG "$time- $note\n";

            open (IDX, "+<$s{'sys'}/log.idx");

                flock (IDX, 2);

                read (IDX, $cnt, 3);

                unless (int $cnt) {

                    seek (IDX, 0, 2);

                    print IDX sprintf ('%016d', $idx); }

                $cnt = 0 if (int $cnt ++) >= 199;

                seek (IDX, 0, 0);

                print IDX sprintf ('%03d', $cnt);

            close IDX;

        close LOG;
    }

    sub tags
    {
        my $str = shift;

        $$str =~ s/\[cyrlat\]([^\[]*)\[\/cyrlat\]/&tagcyrlat($1)/ge;

        $$str =~ s/(\[random[^\]]*\])/&tagrandom($1)/ge;

        $$str =~ s/(\[fromfile[^\]]*\])/&tagfromfile($1)/ge;
    }

    sub tagcyrlat
    {
        my $str = shift || return '';

        $str =~ tr/\xE0\xE5\xEA\xEC\xEE/\x61\x65\x6B\x6D\x6F/;
        $str =~ tr/\xEF\xF0\xF1\xF3\xF5/\x6E\x70\x63\x79\x78/;

        $str =~ tr/\xC0\xC2\xC5\xC7\xCA\xCC/\x41\x42\x45\x33\x4B\x4D/;
        $str =~ tr/\xCD\xCE\xD0\xD1\xD2\xD5/\x48\x4F\x50\x43\x54\x58/;

        return $str;
    }

    sub tagrandom
    {
        my $tag = shift;

        my ($min, $max) = (1, 8);

        my %chars = (num=>[0..9], lat=>['a'..'z'], rus=>[0xE0..0xFF]);

        my @lang; my @chars = ();

        $min = $1 if $tag =~ /min=(\d+)/; $max = $1 if $tag =~ /max=(\d+)/;

        if ($tag =~ /lang=((lat|rus)\+?(lat|rus)?\b)/) {

            my $lang = $1;

            push (@lang, @{$chars{'lat'}}) if $lang =~ /lat/;

            push (@lang, map { chr } @{$chars{'rus'}}) if $lang =~ /rus/; }

        if ($tag =~ /case=((lc|uc|num)\b\+?(lc|uc|num)?\+?(lc|uc|num)?\b)/) {

            my $case = $1;

            if (scalar @lang) {

                push (@chars, @{$chars{'num'}}) if $case =~ /num/;

                push (@chars, @lang) if $case =~ /lc/;

                push (@chars, map { tr/\x60-\x7F\xE0-\xFF/\x40-\x5F\xC0-\xDF/; $_ }
                @lang) if $case =~ /uc/; } }

        $min = $max = 0 if $min > $max; my $z = 1; $z = 0 unless $min;

        my $x = $min; $x = $max - $min + 1 if $min == $max;

        my $y = int (rand ($max - $min + $z)) + $min;

        unless (scalar @chars) { push (@chars, @{$chars{'num'}}, @{$chars{'lat'}}); }

        join ('', @chars[map { rand @chars } ($x..$y)]);
    }

    sub tagfromfile
    {
        my $tag = shift;

        my $file = ''; $file = $1 if $tag =~ /src=(.*)\b/;

        my $line = &getln($file) if -f $file; $line ||= '';
    }

    sub message
    {
        my ($host, $toname, $toaddr, $fromname, $fromaddr, $info) = @_;

        my ($header, $headernum);

        if (-f $c{'attach'} || $c{'mailer'} ne "outlook") {
            ($header, $headernum) = &header($c{'mailer'}); }
        else {
            ($header, $headernum) = &header('outlookna'); }

        my ($fakeip, $fakename) = &ip;

        my ($date) = &date(0);
        my ($fakedate, $faketime) = &date(31536000);

        my ($messageid, $boundary, $cid) = &messageid(1, $fakename);

        my @xpriority = &xpriority($c{'priority'});
        my ($xprionum, $xpriotxt) = @xpriority[0, 2];

        my $replyto = &getln("$s{'sys'}/replyto.tmp");
        my ($replyname, $replyaddr) = (&mailpar($replyto))[1, 2];

        my $subject = &getln("$s{'sys'}/subject.tmp");

        &tags(\$subject);

        my $contenttype = 'text/plain';
        $contenttype = 'text/html' if $c{'letter'} =~ /\.(htm|html)$/;

        my $charset = {win=>'windows-1251', koi=>'koi8-r', iso=>'iso-8859-5'};
        $charset = $charset->{$c{'charset'}} ||= $c{'charset'};

        my $contentenc = '8bit';

        my $message;

        open (M, $c{'letter'});

            flock (M, 1);

            while (<M>) { $message .= $_; }

        close M;

        &tags(\$message);

        my $cell = sub {

            my $cn = shift;

            my @cell = ($toaddr);

            foreach (split (/\|/, $info)) { $_ = &chomp ($_) || ''; push (@cell, $_); }

            return $cell[$cn] || ''; };

        $message =~ s/\%cell(\d+)\%/$cell->($1)/iges;

        my %files;

        if (-f $c{'attach'})
        {
            open (A, $c{'attach'});

                flock (A, 1);

                foreach my $file (<A>)
                {
                    $file = &chomp($file);

                    next unless $file && -f "$s{'sys'}/$file.att";

                    open (F, "$s{'sys'}/$file.att");

                        flock F, 1;

                        while (read (F, my $attbuf, 1024))
                        {
                            $files{$file} .= $attbuf;
                        }

                    close F;
                }

            close A;
        }

        if ($c{'charset'} eq 'koi') {

            $toname = &encbase64(&wintokoi($toname), $charset);
            $fromname = &encbase64(&wintokoi($fromname), $charset);
            $replyname = &encbase64(&wintokoi($replyname), $charset);

            $subject = &encbase64(&wintokoi($subject), $charset);
            $message = &wintokoi($message); }

        elsif ($c{'charset'} eq 'iso') {

            $toname = &encbase64(&wintoiso($toname), $charset);
            $fromname = &encbase64(&wintoiso($fromname), $charset);
            $replyname = &encbase64(&wintoiso($replyname), $charset);

            $subject = &encbase64(&wintoiso($subject), $charset);
            $message = &wintoiso($message); }

        unless ($headernum) {

            ($messageid, $boundary, $cid) = &messageid(0, $fromaddr, $faketime);

            $xprionum = $xpriority[1]; }

        else {

            $contentenc = 'quoted-printable'; }

        $fakedate = $date if $c{'fakedate'} eq 'no';
        $fromname = $replyname = $toname = '' if $c{'exctname'} eq 'no';

        $header =~ s/%FAKENAME%/$fakename/;
        $header =~ s/%FAKEIP%/$fakeip/;
        $header =~ s/%HOST%/$host/;
        $header =~ s/%DATE%/$date/;
        $header =~ s/%FAKEDATE%/$fakedate/;
        $header =~ s/%MESSAGE_ID%/$messageid/;
        $header =~ s/%X_PRIORITYNUM%/$xprionum/;
        $header =~ s/%X_PRIORITYTXT%/$xpriotxt/;

        $header =~ s/%FROMNAME%/$fromname/;
        $header =~ s/%FROMADDR%/$fromaddr/;
        $header =~ s/%REPLY_TONAME%/$replyname/;
        $header =~ s/%REPLY_TOADDR%/$replyaddr/;
        $header =~ s/%TONAME%/$toname/;
        $header =~ s/%TOADDR%/$toaddr/;
        $header =~ s/%SUBJECT%/$subject/;

        $header =~ s/%BOUNDARY%/$boundary/g;
        $header =~ s/%CONTENT_TYPE%/$contenttype/;
        $header =~ s/%CHARSET%/$charset/;
        $header =~ s/%CONTENT_ENCODING%/$contentenc/;

        my ($attach, $attcnt) = ('', 0);

        foreach my $file (keys %files) {

            $attcnt ++;

            my $newcid = $cid . sprintf "%08d", $attcnt;

            $attach .= "\n--" . $boundary . "\n";

            my $ctype = &ctype($file);

            my $fname = $file;

            $fname = &encbase64(&wintokoi($fname), $charset) if $c{'charset'} eq 'koi';
            $fname = &encbase64(&wintoiso($fname), $charset) if $c{'charset'} eq 'iso';

            $attach .= "Content-Type: ";

            unless ($headernum) {

                $attach .= uc $ctype . "; ";
                $attach .= 'name="' . $fname . '"' . "\n";

                if ($message =~ /$file/ && $contenttype eq 'text/html') {

                    $newcid .= '_csseditor';
                    $message =~ s/$file/cid:$newcid/g;

                    $attach .= "Content-ID: <" . $newcid . ">\n";
                    $attach .= "Content-transfer-encoding: base64\n"; }

                else {

                    $attach .= "Content-transfer-encoding: base64\n";
                    $attach .= "Content-Disposition: attachment; filename=";
                    $attach .= '"' . $fname . '"' . "\n"; } }

            else {

                $attach .= $ctype . ";\n\t";
                $attach .= 'name="' . $fname . '"' . "\n";
                $attach .= "Content-Transfer-Encoding: base64\n";

                if ($message =~ /$file/ && $contenttype eq 'text/html') {

                    $newcid .= '@' . $fakename;
                    $message =~ s/$file/cid:$newcid/g;

                    $attach .= "Content-ID: <" . $newcid . ">\n"; }

                else {

                    $attach .= "Content-Disposition: attachment;\n\t";
                    $attach .= 'filename="' . $fname . '"' . "\n"; } }

            $attach .= "\n$files{$file}"; }

        $message = &encquoted($message) if $headernum;

        $message .= $attach;

        $header =~ s/%MESSAGE%/$message/;

        $header =~ s/\n/$CRLF/g;

        return $header;
    }

    sub ip
    {
        my @ip; for (1..4) { push (@ip, int rand 256); } @_ = ('a'..'z');
        return (join ('.', @ip), join ('', @_[map { rand @_ } (0..((int rand 6) + 2))]));
    }

    sub date
    {
        my $date = localtime (time - int rand shift);

        $date =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)$/$1, $3 $2 $5 $4/;

        my %month = (Jan=>'01',Feb=>'02',Mar=>'03',Apr=>'04',May=>'05',Jun=>'06',
        Jul=>'07',Aug=>'08',Sep=>'09',Oct=>'10',Nov=>'11',Dec=>'12');

        my $time = $5 . $month{$2} . (sprintf "%02d", $3) . join ('', split (':', $4));

        return ("$date " . &gmtdiff, $time);
    }

    sub gmtdiff
    {
        my $time = time;
        my @local = (localtime ($time))[2, 1, 3, 4, 5];
        my @gm = (gmtime ($time))[2, 1, 3, 4, 5];

        my $diffdate = ($gm[4] * 512 * 32 + $gm[3] * 32 + $gm[2]) <=>
        ($local[4] * 512 * 32 + $local[3] * 32 + $local[2]);

        if ($diffdate > 0) { $gm[0] += 24; } elsif ($diffdate < 0) { $local[0] += 24; }

        my ($hourdiff, $mindiff) = ($gm[0] - $local[0]);

        if (abs ($gm[1] - $local[1]) < 5) {
            $mindiff = 0; }
        elsif (abs (abs ($gm[1] - $local[1]) - 30) <5) {
            $mindiff = 30; }
        elsif (abs (abs ($gm[1] - $local[1]) - 60) <5) {
            $mindiff = 0; $hourdiff ++; }

        return ($hourdiff < 0 ? '+' : '-') . sprintf "%02d%02d", abs ($hourdiff), $mindiff;
    }

    sub messageid
    {
        my ($mailer, $fakename, $faketime) = @_;
        my ($messageid, $boundary, $cid);

        if ($mailer) {

            my $gr1 = sprintf "%03d", int rand 10;
            my $gr2 = sprintf "%01X", int rand 16;
            my $gr3 = sprintf "%04X", int rand 65536;
            my $gr4 = sprintf "%04X", int rand 65536;
            my $gr5 = sprintf "%04X", int rand 65536;
            my $gr6 = sprintf "%04X", int rand 65536;
            my $gr7 = sprintf "%04X", int rand 65536;

            $messageid .= $gr1 . lc ($gr2) . '01c4' . lc ($gr3) . '$' .
            lc ($gr4) . lc ($gr5) . '$' . lc ($gr6) . lc ($gr7) . '@' . $fakename;

            $boundary .= '----=_NextPart_000_' . $gr1 . (sprintf "%01X", int rand 16) .
            '_01C4' . $gr7 . '.' . $gr6 . $gr5;

            $cid .= $gr1 . lc ($gr2) . '01c4' . lc ($gr3) . '$' .
            lc ($gr4) . lc ($gr5) . '$';

            return ($messageid, $boundary, $cid); }

        @_ = (0..9);
        my $gr1 = join ('', @_[map { rand @_ } (0..((int rand 3) + 7))]);

        @_ = ('A'..'F', 0..9);
        my $gr2 = join ('', @_[map { rand @_ } (0..((int rand 5) + 9))]);

        $messageid = $gr1 . '.' . $faketime . '@' . (split (/\@/, $fakename))[1];
        $boundary = '----------' . $gr2;

        for (1..3) { $cid .= (join ('', @_[map { rand @_ } (0..7)]) . '.'); }

        return ($messageid, $boundary, $cid);
    }

    sub xpriority
    {
        my $lev = shift;
        substr ($lev, 0, 1) = uc substr ($lev, 0, 1);

        my %lev = (Low=>[5, 4], Normal=>[3, 3], High=>[1, 2]);
        $lev = (keys %lev)[int rand keys %lev] unless defined $lev && exists $lev{$lev};

        return (@{$lev{$lev}}, $lev);
    }

    sub encbase64
    {
        my ($enc, $charset) = @_;

        $charset = '=?' . $charset . '?B?';
        my @out; my $ptr = 0; my $str;

        while (my $chr = substr ($enc, $ptr ,1)) {

            $str .= $chr; $ptr ++;

            if (length ($str) == 18) {

                push (@out, $charset . (&base64($str, '')) .  "?="); $str = ''; } }

        push (@out, $charset . (&base64($str, '')) .  "?=") if length ($str);

        return join ("\n\t", @out);
    }

    sub base64 ($;$)
    {
        my $res = '';
        my $eol = $_[1];

        $eol = "\n" unless defined $eol;
        pos ($_[0]) = 0;
        while ($_[0] =~ /(.{1,45})/gs) { $res .= substr (pack ('u', $1), 1); chop ($res); }

        $res =~ tr|` -_|AA-Za-z0-9+/|;
        my $padding = (3 - length ($_[0]) % 3) % 3;
        $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
        if (length $eol) { $res =~ s/(.{1,76})/$1$eol/g; }

        return $res;
    }

    sub encquoted
    {
        my $enc = &quoted($_[0]);

        if (length ($enc) < 74) { $enc =~ s/^\.$/=2E/g; $enc =~ s/^From /=46rom /g; }

        $enc;
    }

    sub quoted ($)
    {
        my $res = shift;

        $res =~ s/([^ \t\n!"#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~])/sprintf("=%02X",
        ord ($1))/eg; $res =~ s/([ \t]+)$/join ('', map { sprintf ("=%02X", ord ($_)) }
        split ('', $1))/egm;

        my $brokenlines = ''; $brokenlines .= "$1=\n" while $res =~ s/(.*?^[^\n]{73} (?:
        [^=\n]{2} (?! [^=\n]{0,1} $)|[^=\n] (?! [^=\n]{0,2} $)|(?! [^=\n]{0,3} $)))//xsm;

        $brokenlines . $res;
    }

    sub wintokoi
    {
        my $str = shift;

        my $win =

        "\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7".
        "\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF".
        "\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7".
        "\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF".
        "\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7".
        "\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF".
        "\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7".
        "\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF";

        my $koi =

        "\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA".
        "\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0".
        "\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE".
        "\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1".
        "\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA".
        "\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0".
        "\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE".
        "\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1";

        eval "\$str=~tr/$win/$koi/;";

        return $str;
    }

    sub wintoiso
    {
        my $str = shift;

        my $win =

        "\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7".
        "\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF".
        "\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7".
        "\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF".
        "\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7".
        "\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF".
        "\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7".
        "\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF";

        my $iso =

        "\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7".
        "\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF".
        "\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7".
        "\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF".
        "\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7".
        "\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF".
        "\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7".
        "\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF";

        eval "\$str=~tr/$win/$iso/;";

        return $str;
    }

    sub header
    {
        my $idx = shift;

    my $thebat = <<'OBJ';
    Received: from %FAKENAME% (%FAKEIP%)
        by %HOST%; %DATE%
    Date: %FAKEDATE%
    From: %FROMNAME% <%FROMADDR%>
    X-Mailer: The Bat! (v2.01)
    Reply-To: %REPLY_TONAME% <%REPLY_TOADDR%>
    X-Priority: %X_PRIORITYNUM% (%X_PRIORITYTXT%)
    Message-ID: <%MESSAGE_ID%>
    To: %TONAME% <%TOADDR%>
    Subject: %SUBJECT%
    MIME-Version: 1.0
    Content-Type: multipart/mixed;
     boundary="%BOUNDARY%"

    --%BOUNDARY%
    Content-Type: %CONTENT_TYPE%; charset=%CHARSET%
    Content-Transfer-Encoding: %CONTENT_ENCODING%

    %MESSAGE%
    --%BOUNDARY%--

    OBJ

    my $outlook = <<'OBJ';
    Received: from %FAKENAME% (%FAKEIP%)
        by %HOST%; %DATE%
    Message-ID: <%MESSAGE_ID%>
    Reply-To: %REPLY_TONAME% <%REPLY_TOADDR%>
    From: %FROMNAME% <%FROMADDR%>
    To: %TONAME% <%TOADDR%>
    Subject: %SUBJECT%
    Date: %FAKEDATE%
    MIME-Version: 1.0
    Content-Type: multipart/mixed;
            boundary="%BOUNDARY%"
    X-Priority: %X_PRIORITYNUM%
    X-MSMail-Priority: %X_PRIORITYTXT%
    X-Mailer: Microsoft Outlook Express 6.00.2800.1158
    X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1165

    --%BOUNDARY%
    Content-Type: %CONTENT_TYPE%;
            charset="%CHARSET%"
    Content-Transfer-Encoding: %CONTENT_ENCODING%

    %MESSAGE%
    --%BOUNDARY%--

    OBJ

    my $outlookna = <<'OBJ';
    Received: from %FAKENAME% (%FAKEIP%)
        by %HOST%; %DATE%
    Message-ID: <%MESSAGE_ID%>
    Reply-To: %REPLY_TONAME% <%REPLY_TOADDR%>
    From: %FROMNAME% <%FROMADDR%>
    To: %TONAME% <%TOADDR%>
    Subject: %SUBJECT%
    Date: %FAKEDATE%
    MIME-Version: 1.0
    Content-Type: %CONTENT_TYPE%;
            charset="%CHARSET%"
    Content-Transfer-Encoding: %CONTENT_ENCODING%
    X-Priority: %X_PRIORITYNUM%
    X-MSMail-Priority: %X_PRIORITYTXT%
    X-Mailer: Microsoft Outlook Express 6.00.2800.1158
    X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1165

    %MESSAGE%
    OBJ

        my @header = ($thebat, $outlook);

        my $header = {thebat=>0, outlook=>1, random=>int rand scalar @header};

        my $select = $header->{$idx};

        return ($outlookna, 1) if $idx eq "outlookna";

        return ($header[$select], $select);
    }

    sub ctype
    {
        my $ext = shift;

        my %ctype = (

        HTML        => 'text/html',
        HTM        => 'text/html',
        SHTM        => 'text/html',
        SHTML        => 'text/html',
        TXT        => 'text/plain',
        PREF        => 'text/plain',
        AIS        => 'text/plain',
        RTX        => 'text/richtext',
        TSV        => 'text/tab-separated-values',
        NFO        => 'text/warez-info',
        ETX        => 'text/x-setext',
        SGML        => 'text/x-sgml',
        SGM        => 'text/x-sgml',
        TALK        => 'text/x-speech',
        CGI        => 'text/plain',
        PL        => 'text/plain',
        INI        => 'text/plain',
        EML        => 'message/rfc822',

        COD        => 'image/cis-cod',
        FID        => 'image/fif',
        GIF        => 'image/gif',
        ICO        => 'image/ico',
        IEF        => 'image/ief',
        JPEG        => 'image/jpeg',
        JPG        => 'image/jpeg',
        JPE        => 'image/jpeg',
        PNG        => 'image/png',
        TIF        => 'image/tiff',
        TIFF        => 'image/tiff',
        MCF        => 'image/vasa',
        RAS        => 'image/x-cmu-raster',
        CMX        => 'image/x-cmx',
        PCD        => 'image/x-photo-cd',
        PNM        => 'image/x-portable-anymap',
        PBM        => 'image/x-portable-bitmap',
        PGM        => 'image/x-portable-graymap',
        PPM        => 'image/x-portable-pixmap',
        RGB        => 'image/x-rgb',
        XBM        => 'image/x-xbitmap',
        XPM        => 'image/x-xpixmap',
        XWD        => 'image/x-xwindowdump',

        EXE        => 'application/octet-stream',
        BIN        => 'application/octet-stream',
        DMS        => 'application/octet-stream',
        LHA        => 'application/octet-stream',
        CLASS        => 'application/octet-stream',
        DLL        => 'application/octet-stream',
        AAM        => 'application/x-authorware-map',
        AAS        => 'application/x-authorware-seg',
        AAB        => 'application/x-authorware-bin',
        VMD        => 'application/vocaltec-media-desc',
        VMF        => 'application/vocaltec-media-file',
        ASD        => 'application/astound',
        ASN        => 'application/astound',
        DWG        => 'application/autocad',
        DSP        => 'application/dsptype',
        DFX        => 'application/dsptype',
        EVY        => 'application/envoy',
        SPL        => 'application/futuresplash',
        IMD        => 'application/immedia',
        HQX        => 'application/mac-binhex40',
        CPT        => 'application/mac-compactpro',
        DOC        => 'application/x-msword',
        ODA        => 'application/oda',
        PDF        => 'application/pdf',
        AI        => 'application/postscript',
        EPS        => 'application/postscript',
        PS        => 'application/postscript',
        PPT        => 'application/powerpoint',
        RTF        => 'application/rtf',
        APM        => 'application/studiom',
        XAR        => 'application/vnd.xara',
        ANO        => 'application/x-annotator',
        ASP        => 'application/x-asap',
        CHAT        => 'application/x-chat',
        BCPIO        => 'application/x-bcpio',
        VCD        => 'application/x-cdlink',
        TGZ        => 'application/x-compressed',
        Z        => 'application/x-compress',
        CPIO        => 'application/x-cpio',
        PUZ        => 'application/x-crossword',
        CSH        => 'application/x-csh',
        DCR        => 'application/x-director',
        DIR        => 'application/x-director',
        DXR        => 'application/x-director',
        FGD        => 'application/x-director',
        DVI        => 'application/x-dvi',
        LIC        => 'application/x-enterlicense',
        EPB        => 'application/x-epublisher',
        FAXMGR        => 'application/x-fax-manager',
        FAXMGRJOB    => 'application/x-fax-manager-job',
        FM        => 'application/x-framemaker',
        FRAME        => 'application/x-framemaker',
        FRM        => 'application/x-framemaker',
        MAKER        => 'application/x-framemaker',
        GTAR        => 'application/x-gtar',
        GZ        => 'application/x-gzip',
        HDF        => 'application/x-hdf',
        INS        => 'application/x-insight',
        INSIGHT        => 'application/x-insight',
        INST        => 'application/x-install',
        IV        => 'application/x-inventor',
        JS        => 'application/x-javascript',
        SKP        => 'application/x-koan',
        SKD        => 'application/x-koan',
        SKT        => 'application/x-koan',
        SKM        => 'application/x-koan',
        LATEX        => 'application/x-latex',
        LICMGR        => 'application/x-licensemgr',
        MAIL        => 'application/x-mailfolder',
        MIF        => 'application/x-mailfolder',
        NC        => 'application/x-netcdf',
        CDF        => 'application/x-netcdf',
        SDS        => 'application/x-onlive',
        SH        => 'application/x-sh',
        SHAR        => 'application/x-shar',
        SWF        => 'application/x-shockwave-flash',
        SPRITE        => 'application/x-sprite',
        SPR        => 'application/x-sprite',
        SIT        => 'application/x-stuffit',
        SV4CPIO        => 'application/x-sv4cpio',
        SV4CRC        => 'application/x-sv4crc',
        TAR        => 'application/x-tar',
        TARDIST        => 'application/x-tardist',
        TCL        => 'application/x-tcl',
        TEX        => 'application/x-tex',
        TEXINFO        => 'application/x-texinfo',
        TEXI        => 'application/x-texinfo',
        T        => 'application/x-troff',
        TR        => 'application/x-troff',
        TROFF        => 'application/x-troff',
        MAN        => 'application/x-troff-man',
        ME        => 'application/x-troff-me',
        MS        => 'application/x-troff-ms',
        TVM        => 'application/x-tvml',
        TVM        => 'application/x-tvml',
        USTAR        => 'application/x-ustar',
        SRC        => 'application/x-wais-source',
        WKZ        => 'application/x-wingz',
        ZIP        => 'application/x-zip-compressed',
        ZTARDIST    => 'application/x-ztardist',

        AU        => 'audio/basic',
        SND        => 'audio/basic',
        ES        => 'audio/echospeech',
        MID        => 'audio/midi',
        KAR        => 'audio/midi',
        MPGA        => 'audio/mpeg',
        MP2        => 'audio/mpeg',
        TSI        => 'audio/tsplayer',
        VOX        => 'audio/voxware',
        AIF        => 'audio/x-aiff',
        AIFC        => 'audio/x-aiff',
        AIFF        => 'audio/x-aiff',
        MID        => 'audio/x-midi',
        MP3        => 'audio/x-mpeg',
        MP2A        => 'audio/x-mpeg2',
        MPA2        => 'audio/x-mpeg2',
        M3U        => 'audio/x-mpegurl',
        MP3URL        => 'audio/x-mpegurl',
        PAT        => 'audio/x-pat',
        RAM        => 'audio/x-pn-realaudio',
        RPM        => 'audio/x-pn-realaudio-plugin',
        RA        => 'audio/x-realaudio',
        SBK        => 'audio/x-sbk',
        STR        => 'audio/x-str',
        WAV        => 'audio/x-wav',

        MPEG        => 'video/mpeg',
        MPG        => 'video/mpeg',
        MPE        => 'video/mpeg',
        QT        => 'video/quicktime',
        MOV        => 'video/quicktime',
        VIV        => 'video/vivo',
        VIVO        => 'video/vivo',
        MPS        => 'video/x-mpeg-system',
        SYS        => 'video/x-mpeg-system',
        MP2V        => 'video/x-mpeg2',
        MPV2        => 'video/x-mpeg2',
        AVI        => 'video/x-msvideo',
        MV        => 'video/x-sgi-movie',
        MOVIE        => 'video/x-sgi-movie',

        PDB        => 'chemical/x-pdb',
        XYZ        => 'chemical/x-pdb',
        CHM        => 'chemical/x-cs-chemdraw',
        SMI        => 'chemical/x-daylight-smiles',
        SKC        => 'chemical/x-mdl-isis',
        MOL        => 'chemical/x-mdl-molfile',
        RXN        => 'chemical/x-mdl-rxn',
        SMD        => 'chemical/x-smd',
        ACC        => 'chemical/x-synopsys-accord',
        ICE        => 'x-conference/x-cooltalk',
        SVR        => 'x-world/x-svr',
        WRL        => 'x-world/x-vrml',
        VRML        => 'x-world/x-vrml',
        VRJ        => 'x-world/x-vrt',
        VRJT        => 'x-world/x-vrt'

        );

        $ext =~ s/^.*\.//;

        return $ctype{uc $ext} || 'application/octet-stream';
    }

    Не забываем кликать спасибо :)
     
    bratok, olegteror и zorg007 нравится это.
  2. kuplu80

    kuplu80 Писатель

    Регистр.:
    1 дек 2007
    Сообщения:
    3
    Симпатии:
    0
    Стукни мне 199-039-788, только я часто в оффлайн.
    Оставь сообщение и скинь скрипт, думаю разберусь.
     
  3. inetlinks

    inetlinks Постоялец

    Регистр.:
    2 сен 2007
    Сообщения:
    146
    Симпатии:
    18
    Вот еще одна версия DirectMailer от 01.06.2005
    Может кому пригодиться ...
    http://depositfiles.com/files/2696517
     
  4. andreipup

    andreipup Писатель

    Регистр.:
    2 окт 2007
    Сообщения:
    3
    Симпатии:
    0
    Скрипт твой не рабочий!
     
  5. evs2

    evs2 Писатель

    Регистр.:
    24 ноя 2007
    Сообщения:
    3
    Симпатии:
    0

    Перезалей плз. ссылка не рабочая.
     
  6. Gansales

    Gansales Прохожие

    Может у кого DirectMailer v.1.6.8 есть? Это вроде последняя версия
     
  7. fuckthesystem

    fuckthesystem Создатель

    Регистр.:
    29 дек 2007
    Сообщения:
    45
    Симпатии:
    6
    у меня есть, а что толку?
     
  8. mistr-t

    mistr-t

    Регистр.:
    4 окт 2006
    Сообщения:
    582
    Симпатии:
    200
    В каком смысле "что толку"?
    Ты выставь, если что, мы сами попробуем разобраться, потестировать и т.д.
    Короче, если есть, выкладывай.
     
  9. Softday

    Softday Читатель

    Заблокирован
    Регистр.:
    4 янв 2008
    Сообщения:
    3
    Симпатии:
    0
    Может скинемься и купим?
     
  10. fuckthesystem

    fuckthesystem Создатель

    Регистр.:
    29 дек 2007
    Сообщения:
    45
    Симпатии:
    6
    вот 1.6.8
    http://www.nulled.ws/showthread.php?t=51158