RE: [SPAM] Re: помогите пожалуйста с перлом

От: Герасимов Александр Викторович <CGatePro_at_mx_ru>
Дата: Tue 03 Mar 2009 - 14:07:31 MSK

В таком варианте всегда говорит что адрес не найден.

sub checkAddress {

        my ($name,$domain)=@_;
        my $lines="";
        my $status="";
        open(FILE,$File1) or return undef;
        while(<FILE>){
                chomp; if(lc eq lc "$name\@$domain"){
                        return $Response1;
                }else{
                        $lines.=$_;
                }
        }
        close(FILE);

   open(FILE,$File2) or return undef;
   while(<FILE>){

      chomp; if(lc eq lc "$name\@$domain"){
         return $Response2;
         last;


      }else{


         $lines.=$_;


      }

   }
   close(FILE);

        return undef;
}

С уважением,
Герасимов Александр

-----Original Message-----
From: CommuniGate Pro Russian Discussions [mailto:CGatePro@mx.ru] Sent: Friday, February 27, 2009 12:56 PM To: CommuniGate Pro Russian Discussions
Subject: [SPAM] Re: [CGP] помогите пожалуйста с перлом

Замените в коде функции CheckAddress обе строчки if(/$name\@$domain/i){ на следующее: chomp; if(lc eq lc "$name\@$domain"){

--
Anatoly A. Orehovsky AO9-RIPE AAO1-RIPN

-----Original Message-----
From: CommuniGate Pro Russian Discussions [mailto:CGatePro@mx.ru] 
Sent: Friday, February 27, 2009 10:03 AM
To: CommuniGate Pro Russian Discussions
Subject: [CGP] помогите пожалуйста с перлом

Добрый день.

В своё время руководством была поставлена задача что необходимо двум разным
компаниям,  находящимися в разных офисах, с разными доменами и ms exchange
серверами сделать адреса в общем почтовом домене, т.е. чтобы в обоих
компаниях был адрес user@company.com. Думал, думал и придумал следующую
схему: у провайдера на виртуальном сервере поднимается CommuniGate на
котором создаются 3 домена company.com, firma1.com & firma2.com, и цепляется
скриптик для внешней авторизации. У каждого пользователя в виндовом АД
ставится основным адресом user@company.com, и из АД экспортируется список
всех адресов пользователей, firma1.txt & firma2.txt. Скрипт проверки
пользователя в CGP сначала проверяет часть адреса до @, т.е. из адреса
user@company.com ищется только user@,  в первом файле, если есть, то
отсылает на ip адрес exchange сервера в первой компании, если не находит, то
ищет в файле firma2, если находит то пересылает на ip второй компании, если
не находит, говорит что пользователь не существует.
Все вроде работает, но иногда какая-то гадина присылает письмо на адрес
+._-gan-79@company.com, что в свою очередь наглухо вешает мой скриптик
внешней авторизации. Но я в перле не силен. Скрипт я сам не писал с нуля, а
немного переделал чей-то найденный в инете. Ребята помогите, подскажите что
и где поправить. Чтобы если адрес не соответствовал стандарту e-mail адреса,
то сразу говорилось что пользователь не найден. А может и еще найдете
потенциальные ошибки в скрипте, и подскажите как их исправить.

Передаем что-то типа: nnn NEW user@company.com
Скрипт возвращает: если адрес найден nnn ROUTED user%firma1.com@[1.2.3.4]
или nnn ERROR address NOT found

Собственно сам скрипт:

#!/usr/bin/perl -w

$| = 1;     #force STDOUT autoflush after each write

my $File1 = '/home/company/data/firma1.txt';
my $Response1 = 'firma1.com@[1.2.3.4]';
my $File2 = '/home/company/data/firma2.txt';
my $Response2 = 'firma2.com@[5.6.7.8]';

while(<STDIN>) {
  chomp;    # remove \n from the end of line
  my ($prefix,$method,@eargs) = split(/ /);

  if($method eq 'NEW') {
    unless($prefix && $method && $eargs[0]) {
      print "$prefix ERROR Expected: nnn NEW user\@domain\n";
    } else {
      if($eargs[0] =~ /^\(.*\)$/) {
        shift @eargs;


      }

       if($eargs[0] =~ /(.+)\@(.+)/) {
            $name=$1;
            $domain=$2;
        } else {
            return "ERROR Full account name with \@ and domain part
expected";
        }
      my $RouteServer=checkAddress($name,$domain);
      if(defined $RouteServer) {
        print "$prefix ROUTED $name\%$RouteServer\n";


      } else {


        print "$prefix ERROR address NOT found\n";


      }

    }
  }
  elsif ($method eq 'INTF' ) {
    if($eargs[0] < 3) {
      print "* This script requires CGPro version 4.1b7 or newer\n";
      exit;
    }
    print "$prefix INTF 3\n";
  }
  else {
    print "$prefix ERROR Only NEW and INTF commands supported\n";
  }
}

sub checkAddress {
        my ($name,$domain)=@_;
        my $lines="";
        my $status="";
        open(FILE,$File1) or return undef;
        while(<FILE>){
                if(/$name\@$domain/i){
                        return $Response1;
                }else{
                        $lines.=$_;
                }
        }
        close(FILE);
   open(FILE,$File2) or return undef;
   while(<FILE>){
      if(/$name\@$domain/i){
         return $Response2;
         last;


      }else{


         $lines.=$_;


      }

   }
   close(FILE);
        return undef;
}




С уважением,
Герасимов Александр

##################################################################
Вы получили это сообщение потому, что подписаны на список рассылки
  <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@mx.ru>
Чтобы переключиться в режим дайджеста - mailto:<CGatePro-digest@mx.ru>
Чтобы переключиться в индексный режим - mailto:<CGatePro-index@mx.ru>
Для административных запросов адрес <CGatePro-request@mx.ru>
Архив списка: http://mx.demos.su/lists/cgp-russian/

Получено Tue Mar 03 11:06:43 2009