помогите пожалуйста с перлом

От: Герасимов Александр Викторович <CGatePro_at_mx_ru>
Дата: Fri 27 Feb 2009 - 10:03:23 MSK

Добрый день.

В своё время руководством была поставлена задача что необходимо двум разным компаниям, находящимися в разных офисах, с разными доменами и 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;
}

С уважением,
Герасимов Александр Получено Fri Feb 27 07:02:35 2009