У меня он на win и работает. Ставь Perl + библиотеку CLI перекинуть в него.
Чанов Андрей
-----Original Message-----
From: CommuniGate Pro Russian Discussions [mailto:CGatePro@mx.ru]
Sent: Tuesday, March 18, 2008 1:50 PM
To: CommuniGate Pro Russian Discussions
Subject: Re: [CGP] Вопрос по скриптику на Perl - для сортировки и удаления спама
Добрый день, вопросик в догонку
Если у меня CG стоит на W2k3, каким образом я могу запустить это скрипт?
Необходимо ставить Perl?
С уважением Дмитрий
Чанов Андрей Дмитриевич пишет:
> Сам себе и отвечу :)
>
> Прикладываю пару скриптов облегчающих жизнь юзерам при использовании спаморезки (спаморезка приписывает в тему Spam).
> Вдруг кому надо.
>
> Первый скрипт у всех создаёт правило Spam, если такое существует исправляет его + создаёт папку Spam.
>
>
> #!/usr/bin/perl -w
>
> use CLI;
>
> my $cli = new CGP::CLI( { PeerAddr => 'server.ru',
> PeerPort => 106,
> login => 'postmaster',
> password => 'password'
> } )
> || die "Can't login to CGPro: ".$CGP::ERR_STRING."\n";
>
> my $domList=$cli->ListDomains() || die "can't list domains";
>
> foreach $domain (sort @$domList) {
> $AccountList = $cli->ListAccounts($domain)
> || die "Error: ".$cli->getErrMessage.", quitting";
> foreach(keys %$AccountList) {
> $address = "$_\@$domain";
> print "$address\n";
>
> my $Rules=$cli->GetAccountRules($address)
> || die "Error: ".$cli->getErrMessage.", quitting";
>
> $foundrule = 0;
>
> foreach my $Rule (@$Rules) { if ($Rule->[1] eq 'Spam') {$foundrule
> = 1;
>
> # Update Mail Rule if exist
>
> $filter_rule = ( [5,'Spam',[["Subject",'is',"*Spam*"]]
> ,[["Store in",'Spam'],["Discard"]]]
> );
>
> print " Updating Spam Filter Rule!\n";
>
> $cli->UpdateAccountMailRule($address,$filter_rule)
>
> || die "Error: ".$cli->getErrMessage.", quitting";
> #
>
> } }
>
> unless ($foundrule) {
> $filter_rule = ( [5,'Spam',[["Subject",'is',"*Spam*"]]
> ,[["Store in",'Spam'],["Discard"]]]
> );
>
> @NewRules = (@$Rules, $filter_rule);
> print " Creating Spam Filter Rule!\n";
> $cli->SetAccountRules($address,\@NewRules)
>
> # $cli->UpdateAccountMailRule($address,\@NewRules)
>
> || die "Error: ".$cli->getErrMessage.", quitting";
> }
>
>
> my $Boxes= $cli->ListMailboxes(accountName=>$address)
> || die "Error: ".$cli->getErrMessage.", quitting";
>
> $foundbox = 0;
>
> foreach (sort keys %$Boxes) { if ($_ eq "Spam") { $foundbox = 1;}
> }
>
> unless ($foundbox) {
> print " Creating Spam box\n";
> $cli->CreateMailbox($address,'Spam')
> || die "Error: ".$cli->getErrMessage.", quitting";
> }
> }
> }
>
> $cli->Logout;
>
>
> Второй трёт из папки спам всё что старше 7 дней.
>
>
> #!/usr/bin/perl -w
> #
> # The old mail deletion script for CommuniGate Pro.
> #
> # This script deletes all mail older than the number of days specified
> below # in $keepForDays variable. The time is compared against
> messages' INTERNALDATE # attribute which may be not the same as the
> date when the message was received, # so don't get confused if after the deletion you see messages older than expected.
> #
> # The mail is deleted from all mailboxes in all accounts in all
> domains, # including mailing list archives. Mail marked for deletion
> by users is also # deleted. You may want to modify this script to
> process not all but only certain # domains or accounts. Use this
> script with extreme care becasue mail once deleted # is not recoverable.
> #
> # Please mail your comments and suggestions to <support@stalker.com> #
>
> my $keepForDays = 7;
>
> use CLI;
>
> my $deadlineDate=getDeadlineDate();
>
> print "\nWARNING!!!\n";
> print "This script will delete messages received before $deadlineDate
> from all\n"; print "mailboxes in all acounts in all domains. Make sure
> you know what you're\n"; print "doing. It's not too late to hit
> Ctrl-C.\n\n";
>
> print "CommuniGate Pro domain: ";
>
> my $Domain = 'server.ru';
>
> #my $Domain = <STDIN>;
> #chomp $Domain;
>
> $CGServerAddress = $Domain;
>
> #my $Login = "Postmaster\@$Domain";
>
> my $Login = "postmaster\@$Domain";
>
> print "Postmaster's password: ";
>
> my $Password = 'password';
>
> #my $Password = <STDIN>;
> #chomp $Password;
>
>
> my $imap = new IO::Socket::INET( PeerAddr => $CGServerAddress,
> PeerPort => 143
> )
> || die "*** Can't connect to CGPro via IMAP.\n";
>
> $imap->autoflush(1);
> my $responseLine = <$imap>;
>
> print "$responseLine\n";
>
> print $imap "x LOGIN $Login $Password\n"; do {
> $responseLine = <$imap>;
> }until($responseLine =~/^x /);
> die "*** Can't login to CGPro IMAP: $responseLine.\n"
> unless($responseLine =~ /^x OK/);
>
> my $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,
> PeerPort => 106,
> login => $Login,
> password => $Password } )
> || die "*** Can't login to CGPro CLI: ".$CGP::ERR_STRING."\n";
>
>
>
> #processAccount('test@company.com');
> processAllDomains();
> exit;
>
> sub processAllDomains() {
> my $DomainList = $cli->ListDomains()
> || die "*** Can't get the domain list: ".$cli->getErrMessage.", quitting";
> foreach(@$DomainList) {
> processDomain($_);
> }
> }
>
> sub processDomain() {
> my $domain=$_[0];
> print "Domain: $domain\n";
> my $accountList = $cli->ListAccounts($domain);
> unless($accountList) {
> print "*** Can't get accounts for $domain: ".$cli->getErrMessage."\n";
> return;
> }
> foreach(keys %$accountList) {
> processAccount("$_\@$domain");
> }
> }
>
> sub processAccount() {
> my $account=$_[0];
> #print "Account: $account\n";
> print "Account: $account\n";
> my $mailboxesList=$cli->ListMailboxes(accountName=>$account);
> unless($mailboxesList) {
> print "*** Can't list mailboxes for $account:".$cli->getErrMessage."\n";
> return;
> }
> foreach(keys %$mailboxesList) {
> my $data=@$mailboxesList{$_};
> if(ref $data eq 'HASH') {
> my $nMessages=@$data{'Messages'};
> if(defined $nMessages && $nMessages eq 0) {
> #print "skipping empty $account/$_\n";
> print "skipping empty $account/$_\n";
> next;
> }
> }
>
> #processMailbox("$account/$_");
>
> # стираем только в папке Spam
> processMailbox("$account/Spam");
>
> }
> }
>
> sub processMailbox() {
> my $mailbox=$_[0];
> my $delList = "";
>
> print "Mailbox: $mailbox\n";
>
> #print $imap "x SELECT \"~$mailbox\"\n";
>
> print $imap "x SELECT \"~$mailbox\"\n";
>
> do {
> $responseLine = <$imap>;
> }until($responseLine =~/^x /);
> unless($responseLine =~ /^x OK/) {
> print "*** Can't select $mailbox: $responseLine.\n";
> return;
> }
> print $imap "x SEARCH BEFORE $deadlineDate UNDELETED\n";
> do {
> $responseLine = <$imap>;
> if($responseLine =~ /^\* SEARCH (.+)/) {
> $delList.=' ' if($delList ne "");
> $delList.=$1;
> }
> }until($responseLine =~/^x /);
>
> if($delList ne "") {
> $delList =~ s/ /\,/g;
> print "Mailbox: $mailbox\n";
> print "deletion list=$delList\n";
>
> #return;
>
> print $imap "s STORE $delList +FLAGS (\\Deleted)\n";
>
> do {
> $responseLine = <$imap>;
> }until($responseLine =~/^s /);
> unless($responseLine =~ /^s OK/) {
> print "*** Can't store flags for $mailbox messages: $responseLine.\n";
> }
> print $imap "c CLOSE\n";
> do {
> $responseLine = <$imap>;
> }until($responseLine =~/^c /);
> unless($responseLine =~ /^c OK/) {
> 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()-$keepForDays*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/
>
>
>
>
##################################################################Вы получили это сообщение потому, что подписаны на список рассылки <CGatePro@mx.ru>.
Чтобы отписаться, отправьте сообщение на адрес <CGatePro-off_at_mx.ru> Чтобы переключиться в режим дайджеста - mailto:<CGatePro-digest_at_mx.ru> Чтобы переключиться в индексный режим - mailto:<CGatePro-index_at_mx.ru> Для административных запросов адрес <CGatePro-request_at_mx.ru> Архив списка: http://mx.demos.su/lists/cgp-russian/ Получено Tue Mar 18 11:36:33 2008
Этот архив был сгенерирован hypermail 2.1.8 : Fri 24 Apr 2015 - 16:16:03 MSK