Re: Re[2]: Периодическая очистка старых писем

От: Dmitry Baronov <CGatePro_at_mx_ru>
Дата: Thu 20 Dec 2007 - 11:12:07 MSK

Sergey Ilyukhin пишет:
> Здравствуйте, Dmitry.
>
> Вы писали 19 декабря 2007 г., 15:30:08:
>
> DB> Я уже выкладывал сюда Perl/CLI-скрипт, который делает вот что:
>
> DB> 1. Создает каждому юзеру домена персональный фолдер Spam, если его нет.
> DB> 2. Создает каждому юзеру правило по отмувливанию помеченных
> DB> Spamassasin'ом писем в этот фолдер (если правила еще нет)
> DB> 3. Грохает письма из фолдеров Spam по прошествии заданного периода.
>
> DB> Пашет как часы уже около 2 лет.
>
> Дайте пожалуйста ссылочку скачать! Для меня актуальная тема

Вот он тут весь:

---

#!/usr/bin/perl -w

  use CLI;
  $CGServerAddress = "10.10.1.3";

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

     my $Password = "111111111";
     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('domain.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 $is_deny_box = 0;

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


              foreach (sort keys %$Boxes) {

                 my $boxname=$_;
#               print "\n $boxname";
                 if ($boxname eq 'Spam')
                 {$is_spam_box = 1}
                 if ($boxname eq '&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-')
                 {$is_deny_box = 1}

                 }

     if ($is_spam_box == 0)
     {
     $cli->CreateMailbox($acc,'Spam')
         || die "Error: ".$cli->getErrMessage.", quitting";

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

     if ($is_deny_box == 1)
     {
#    print "\n$acc - !!!";
     processMailbox("$acc/&BB4EQgQ,BEAEMAQyBDsENQQ9BD0ESwQ1-", 
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);



------------------------------

>
>
>
> ##################################################################
> Вы получили это сообщение потому, что подписаны на список рассылки
> <CGatePro@mx.ru>.
>
> Чтобы отписаться, отправьте сообщение на адрес <CGatePro-off@mx.ru>
> Чтобы переключиться в режим дайджеста - mailto:<CGatePro-digest@mx.ru>
> Чтобы переключиться в индексный режим - mailto:<CGatePro-index@mx.ru>
> Для административных запросов адрес <CGatePro-request@mx.ru>
> Архив списка: http://mx.demos.su/lists/cgp-russian/
>
>
>
Получено Thu Dec 20 08:12:28 2007