Spam Moving once more

От: Dmitry Baronov <CGatePro_at_mx_ru>
Дата: Mon 10 Jul 2006 - 13:32:23 MSD

Накорябано на коленке путем склеивания посредством матюгов нескольких разных неизвестно кем написанных скриптов. Создает у всех усеров домена мэйлбокс Spam и правило перемещения туда писем с X-Spam-Status: Yes. Удаляет из спамового мэйлбокса все что старше 2 недель. У меня работает. Ногами не пинать, перловку не пользовал лет как 5, все забыл. Кто перепишет это красиво и в духе перловой религии, закиньте сюда плз.

---

#!/usr/bin/perl -w

 use CLI;
 $CGServerAddress = "10.10.1.3";     

    my $Login = "postmaster\@domain.com"; # print "Password: ";

    my $Password = "password";
    chomp $Password;

    $imap = new IO::Socket::INET(

                PeerAddr => $CGServerAddress,
                PeerPort => 143)
                || die "*** Can't connect to CGPro via IMAP.\n";

    $imap->autoflush(1);    

    my $responseLine = <$imap>;    

    unless (SendIMAP("LOGIN $Login $Password"))     {

        die "*** Can't login to CGPro IMAP: $responseLine.\n"     }

    my $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,

    PeerPort => 106,
    login    => $Login,
    password => $Password,
    SecureLogin => 0} )
        || die "Can't login to CGPro: ".$CGP::ERR_STRING."\n";
    $AccountList = $cli->ListAccounts('metholding.com')
        || die "Error: ".$cli->getErrMessage.", quitting";
    foreach(keys %$AccountList) {
          print "\n",$_."\n";
          $ACC = $_;
          crtspmbox($ACC);
        }

        sub crtspmbox {
        my $acc = shift;
        my $is_spam_rule = 0;
        my $is_spam_box = 0;

    my $Boxes=$cli->ListMailboxes(accountName=>$acc)
            || die "Error: ".$cli->getErrMessage.", quitting";


             foreach (sort keys %$Boxes) {
                my $boxname=$_;
                if ($boxname eq 'Spam')
                {$is_spam_box = 1}

                }

    if ($is_spam_box == 0)
    {
    $cli->CreateMailbox($acc,'Spam')

        || die "Error: ".$cli->getErrMessage.", quitting";    

    }
    else
    {
    processMailbox("$acc/Spam", getDeadlineDate(14));     }

        my $Rules=$cli->GetAccountRules($acc)
            || die "Error: ".$cli->getErrMessage.", quitting";
           
         foreach my $Rule (@$Rules) {
          my $conditions=$Rule->[2],$actions=$Rule->[3];
          print "\nName='$Rule->[1]' Priority=$Rule->[0]";
          print "  If\n  ";
            if ($Rule->[1] eq "MoveSpam")
                {$is_spam_rule = 1}
          foreach my $cond (@$conditions) {
                print " $_ " foreach (@$cond);
              print "\n  ";
                      }
                  print "Then\n  ";
              foreach my $actn (@$actions) {
                print " $_ " foreach (@$actn);
              print "\n  ";
                      }
                }
            if ($is_spam_rule == 0)
           
            {
                push @$Rules, ( [ 7, 'MoveSpam',
              [['Header Field', 'is', '*X-Spam-Status: Yes*']],
             [['Store in', "~".$acc."/Spam"],
            ['Discard']] ]);
        $cli->SetAccountRules($acc,\@$Rules) || die "Error:
        ".$cli->getErrMessage .", quitting";
           
            }
        }

sub SendIMAP
{

    my $responseLine = "";
    print $imap "x $_[0]\n";
    $responseLine = <$imap> until($responseLine =~/^x /);     return $responseLine =~ /^x OK/;
}

sub processMailbox
{

    my ($mailbox,$deadlineDate) = @_;
    print "\n $mailbox, $deadlineDate";

    my $delList = "";

    unless(SendIMAP('SELECT "~'.$mailbox.'"'))     {

        print "*** Can't select $mailbox.\n";
        return;

    }

    print $imap "x SEARCH BEFORE $deadlineDate UNDELETED\n";     my $responseLine = "";
    until($responseLine =~/^x /)
    {

        $responseLine = <$imap>;
        print "\n $responseLine";
        if($responseLine =~ /^\* SEARCH (.+)/)
        {
            $delList.=' ' if($delList ne "");
            $delList.=$1;
        }

    }

    if ($delList ne "")
    {

        $delList =~ s/ /\,/g;
        print "Mailbox: $mailbox\n";
        print "deletion list=$delList\n";

        #return;
        unless(SendIMAP("STORE $delList +FLAGS (\\Deleted)"))
        {
            print "*** Can't store flags for $mailbox messages: 
$responseLine.\n";
        }
        unless(SendIMAP("CLOSE"))
        {
            print "*** Can't close $mailbox: $responseLine.\n";
        }

    }
}

sub getDeadlineDate
{

    my @mNames=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);     my $deadlineTime=time()-$_[0]*24*60*60;     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($deadlineTime);

    return $mday.'-'.$mNames[$mon].'-'.(1900+$year); Получено Mon Jul 10 09:32:37 2006