По видимому у Вас файлы с адресами в DOS/Windows формате - строки кончаются символами CR-LF.
Если эти файлы в таком формате и останутся, то проще всего chomp; if(lc eq lc "$name\@$domain"){ заменить на chomp; if(lc eq lc "$name\@$domain\r"){.
Также надо иметь в виду, что в таком варианте требования к файлам с адресами достаточно жесткие - на строке должен быть только адрес, ни до, ни после него никаких символов быть не должно. В том числе и пробелов с табуляциями.
--
Anatoly A. Orehovsky AO9-RIPE AAO1-RIPN
-----Original Message-----
From: CommuniGate Pro Russian Discussions [mailto:CGatePro@mx.ru]
Sent: Tuesday, March 03, 2009 2:08 PM
To: CommuniGate Pro Russian Discussions
Subject: Re: [CGP] [SPAM] Re: [CGP] помогите пожалуйста с перлом
В таком варианте всегда говорит что адрес не найден.
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);
chomp; if(lc eq lc "$name\@$domain"){
return $Response2;
last;
}else{
$lines.=$_;
}
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";
}
print "* This script requires CGPro version 4.1b7 or newer\n";
exit;
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);
if(/$name\@$domain/i){
return $Response2;
last;
}else{
$lines.=$_;
}
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/
##################################################################Вы получили это сообщение потому, что подписаны на список рассылки <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 14:49:09 2009
Этот архив был сгенерирован hypermail 2.1.8 : Tue 03 Mar 2009 - 20:14:57 MSK