"Белый список" spamassassin руками пользователей.

В очередной раз победила лень - надоело редактировать белый список spamassassin вручную. Было принято волевое решение переложить этот труд на тех, кому он и нужен - на пользователей. Для чего и был написан скрипт.
Как обычно - если уж вы решились на использование данного скрипта, то:
Автор не несет ответственности за любые последствия которые могут наступить в результате установки и использования описанного ниже скрипта, пользователь использует его "как есть" на свой страх и риск.



Что используем:
   Любой дистрибутив Linux/BSD, ничего специфичного не использовалось, думается должно работать везде.
   Perl и его модули Mail::IMAPClient, MIME::Lite, Switch


Логика работы скрипта:
   Пользователь отправляет на специальный электронный адрес письмо, указав в поле "Тема" список адресов, которые необходимо добавить в белый список. Адреса разделяются запятыми. Запускаемый по cron'у скрипт, подключается к почтовому ящику по протоколу IMAP, считывает заголовки сообщений (поля "От", "Тема" и номер сообщения), проверяет указанные адреса на правильность написания, на наличие этих адресов в белом или черном списке после чего, в случае отсутствия ошибок, добавляет их в белый список и отправляет пользователю письмо с результатами обработки запроса. Обработанные сообщения перемещаются из папки "Входящие" в архивную папку, на всякий пожарный...
   Так же реализована возможность разрешить редактирование белого списка только некоторым пользователям, для этого нужно прописать e-mail этих пользователей в текстовом  файле, один e-mail на строку и присвоить в скрипте переменной $acl значение 1. При попытке добавления адреса пользователем не прописанным в списке, ему будет отправлено сообщение о запрете на изменение белого списка. Сообщение перемещается в корзину.
   Скрипт создает лог-файл (по умолчанию /var/log/sawl.log), в который пишет результаты своей работы и ошибки, если они возникают. Эту функцию можно отключить установив переменную $enablelog равной 0 (нулю). В таком случае информация будет выводиться на стандартный вывод(на консоль при запуске в ручную, в письмо для root, при запуске через cron)

Установка модулей Perl:

host # perl -MCPAN -e shell
cpan > istall Mail::IMAPClient
cpan > istall MIME::Lite
cpan > quit

Подготовка к работе:
   Создаем скрипт sawl.pl, со следующим содержимым:

#! /usr/bin/perl -w
#Данный скрипт предназначен для самостоятельного добавления
#пользователями адресов электронной почты в белый список
#spamassassin
require 5.0;
#Доступ к почте по IMAP
use Mail::IMAPClient;
#Чтобы работал case
use Switch;
#Формирование и отправ e-mail
use MIME::Lite;
#Дата и время POSIX для лога
use POSIX qw(strftime);
#####################################################################
#Меняете переменные описанные ниже в соответствии с Вашей конфигурацией
#Указываем откуда брать входящие и куда складывать обработанные сообщения
$folder="INBOX";
$archive="done";
#e-mail обработчика
$e_mail='whitelist@example.com';
#Адрес IMAP, логин, пароль, путь к user_prefs или к local.cf
$host='192.168.0.X';
$id='whitelist@example.com';
$pass='whitelist_password';
$wlist="/path/to/user_prefs";
#Запись в лог 0-off, 1-on.
$enablelog=1;
$log="/var/log/sawl.log";
#Права на запись в белый список 0-для всех, 1-для избранных
$acl=0;
$aclist="/path/to/acl";
#Дальше ничего менять не нужно, глобальных переменных ниже нет.
#######################################################################
#Отправка сообщения о результате обработки
sub send_msg($$)
{
local $msg = MIME::Lite->new(
From => 'SpamAssassin <'.$e_mail.'>',
To => $_[0],
Subject => 'Результаты обработки запроса.',
Data => $_[1]
);
$msg->attr('content-type.charset'=>'UTF-8');
$msg->send;
}
#Проверка адресов на наличие в черном\белом списке
sub chklst ($$)
{
local $result;
$result=$_[1];
if (open (LST, "<".$wlist)) { local $wsearch="whitelist_from ".$_[0]; local $bsearch="blacklist_from ".$_[0]; while (<LST>)
{
$result=2 if /$wsearch/;
$result=3 if /$bsearch/;
}
close (LST);
}
else
{
die write_log ($log,"Не могу открыть белый список!");
}
return $result;
}
#Формируем тело сообщения заказчику в зависимости от результатов проверок
sub a_body($$)
{
local $result;
switch ($_[1])
{
case 0
{
$result="Адрес ".$_[0]." успешно добавлен в белый список.\n";
}
case 1
{
$result="Адрес ".$_[0]." не прошол проверку! Вероятно ошибка в написании.\n";
}
case 2
{
$result="Адрес ".$_[0]." уже присутствует в белом списке.\n";
}
case 3
{
$result="Адрес ".$_[0]." присутствует в черном списке, в добавлении отказано.\n";
}
case 4
{
$result="Адрес ".$_[0]." не удалось добавить в белый список! Системный сбой.\n";
}
}
return $result;
}
#Разбиение строки и проверка e-mail на валидность
sub m_format($$$)
{
local $i=0;
local @result;
local @from=split($_[0],$_[1]);
foreach (@from) { s/^(\s*)//gi }
foreach (@from) { s/^(\s*)$//gi }
foreach $from (@from)
{
if ($from ne "") { $from =~ s/^(.*?)([\w\_\-\.]+\@[\w\_\-\.]+\.\w{2,6})(.*)$/$2/gi; }
switch($_[2])
{
#В поле "Тема" может быть много адресов
case "subject"
{
if ($from =~ m/^([\w\_\-\.]+\@[\w\_\-\.]+\.\w{2,6})$/gi)
{
$result[$i]=$from.",0";
}
else
{
$result[$i]=$from.",1";
}
$i++;
}
#а в поле "От" только один
case "from"
{
if ($from =~ m/^([\w\_\-\.]+\@[\w\_\-\.]+\.\w{2,6})$/gi)
{
$result[$i]=$from;
$i++;
}
}
}
}
if (@result==1) {return $result[0];}
else {return @result;}
}
#Чтение заголовков сообщений
sub read_msg_headers($)
{
local $i=0;
local $msg;
local @msginfo;
#Выбираем папку "Входящие"
$_[0]->select($folder);
my $msgcount = $_[0]->message_count();
defined($msgcount) or die "Could not message_count: $@\n";
if ($msgcount>0)
{
local @msgs = $_[0]->search("ALL");
foreach $msg (@msgs)
{
$msginfo[$i][0]= $msg;
$msginfo[$i][1]= $_[0]->get_header($msg, "Subject");
$msginfo[$i][2]= $_[0]->get_header($msg, "From");

$i++;
}
return @msginfo;
}
else
{
write_log($log,"Нет новых запросов. Выход. \n");
exit;
}
}
#Запись в лог
sub write_log($$)
{
if ($enablelog==1)
{
open(LOG, ">>" . $_[0]); print(LOG $_[1]."\n"); close(LOG);
}
else
{
print $_[1]."\n";
}
}
#######################################################################
#Если включено логирование, проверяем файл лога на существование
#Если не существует, то пытаемся его создать.
if ($enablelog==1)
{
if (!(-f"$log"))
{
print "Лог-файл не существует! Пытаюсь создать...\n";
if (system("/bin/touch $log")!=0)
{
#Если не получилось, отключаем логирование и продолжаем работу.
print "Невозможно создать лог-файл! Запись в лог отключена!\n";
$enablelog=0;
}
else {print "Ok\n";}
}
}
my $ltime=strftime "[%Y.%m.%d %H-%M-%S]", localtime;
write_log($log,$ltime);

#Подключение к п.я.
write_log ($log,"Подключение к почтовому серверу...");
my $imap = Mail::IMAPClient->new(
Server => $host,
User => $id,
Password => $pass)
or die write_log($log,"ERROR: Не могу соединиться с сервером $host как $id: $@");
#Читаем поля "От","Тема" и Message ID всех пришедших сообщений
my @msgs=read_msg_headers($imap);
#Обрабатываем полученые заголовки
$size=@msgs-1;
for $i(0..$size)
{
#От кого пришло письмо?
$from=m_format(" ",$msgs[$i][2],"from");
#Обрабатываем права пользователя на добавление в белый список
if ($acl==1)
{
my $grant=0;
if (open (ACLST, "<".$aclist)) { while (<ACLST>)
{
$grant=1 if /$from/;
}
close (ACLST);
}
else
{
write_log($log,"ERROR: Не удалось открыть список разрешонных пользователей!");
write_log($log,"Выход. \n");
exit;
}
if ($grant==0)
{
write_log($log,"Запрещено вносить изменения пользователю ".$from.".");
send_msg($from,"У Вас нет прав на изменение белого списка!");
my $newID = $imap->move("trash",$msgs[$i][0])
or die write_log($log,"Не могу переместить сообщение: $@\n");
$imap->expunge;
next;
}

}
my $msgbody="Результаты обработки запроса на добавление в \"белый список\": \n";
#Разбираем строку темы, на предмет добавляемых адресов
foreach $toadd (m_format(",",$msgs[$i][1],"subject"))
{
#Проверяем на вхождение в белый/черный список
@tstr=split(",",$toadd);
$tstr[1]=chklst($tstr[0],$tstr[1]);
#Если нет ошибок и нет вхождений в б.с./ч.с. то добавляем
if ($tstr[1]==0)
{
if (open (LST, ">>".$wlist))
{
print(LST "\nwhitelist_from ".$tstr[0]);
close (LST);
write_log($log,$from."->".$tstr[0]);
}
else
{$tstr[1]=4;
write_log($log,"ERROR: Не удалось открыть user_prefs для записи.");
}
}
#Формируем отчет для пользователя
$msgbody=$msgbody.a_body($tstr[0],$tstr[1]);
}
#и отправляем его
send_msg($from,$msgbody);
#Перемещаем обработанное сообщение в архивную папку
my $newID = $imap->move($archive,$msgs[$i][0])
or die write_log($log,"Не могу переместить сообщение: $@\n");
$imap->expunge;
}
#Отключаемся от сервера.
$imap->disconnect or die write_log($log,"Ошибка отключения от сервера $host: $@\n");
write_log($log,"Выход.\n");
exit;

Во избежании проблем, связанных с работой парсера на странице, рекомендую взять скрипт здесь. Редактируем глобальные переменные в соответствии с вашей конфигурацией.
Создаем список разрешенных пользователей:

host # touch /path/to/acl

 Приводим его к следующему виду:

host # cat /path/to/acl
user@example.com
user1@example.com
user2@example.com

Отправляем пару писем на адрес скрипта, запускаем скрипт вручную, смотрим лог, проверяем user_prefs. Если все нормально - прописываем в crontab