Perl Script анализа почтовых логов

Тема в разделе "Perl программирование", создана пользователем andrey2010, 29 мар 2010.

  1. andrey2010

    andrey2010 Гость

    Есть небольшой скриптик на perl, который нашел в инете. Он заводит в БД mysql данные из файла логов /va/log/maillog в удобоваримой форме (т.е показывает в какое время, от кого, куда ушло письмо). Хотелось его модифицировать, добавив статус письма. Если с писмом все нормально, но в столбец status заводится например, что письмо доставлено.
    Но проблемы возникли письмами, которые стоят в очереди по каким-либо причинам (неправ ящик или smtp сервер отверг прием письма по каким-либо причинам).


    Вот лог:
    Код (Text):
    #лог задержанного письма
    cat /var/log/maillog | grep EA59E4448C8
    Mar 29 13:56:22 mail postfix/smtpd[64983]: EA59E4448C8: client=unknown[10.0.33.97], sasl_method=LOGIN, sasl_username=admin
    Mar 29 13:56:23 mail postfix/cleanup[64987]: EA59E4448C8: message-id=<op.vabkeky64azo2s@xxxx>
    Mar 29 13:56:23 mail postfix/qmgr[64329]: EA59E4448C8: from=<admin@xxx>, size=666, nrcpt=1 (queue active)
    Mar 29 13:56:28 mail postfix/smtp[64989]: EA59E4448C8: to=<test@e1.ru>, relay=127.0.0.1[127.0.0.1]:10024, delay=8.9, delays=3.1/0.02/0.01/5.7, dsn=2.0.0,
    status=sent (250 2.0.0 from MTA([127.0.0.1]:10025): 250 2.0.0 Ok: queued as C2C0F44494A)
    Mar 29 13:56:28 mail postfix/qmgr[64329]: EA59E4448C8: removed

    cat /var/log/maillog | grep C2C0F44494A
    Mar 29 13:56:28 mail postfix/smtpd[64991]: C2C0F44494A: client=localhost[127.0.0.1]
    Mar 29 13:56:28 mail postfix/cleanup[64987]: C2C0F44494A: message-id=<op.vabkeky64azo2s@xxx>
    Mar 29 13:56:28 mail postfix/qmgr[64329]: C2C0F44494A: from=<admin@xxx>, size=1073, nrcpt=1 (queue active)
    Mar 29 13:56:28 mail amavis[64729]: (64729-02) Passed CLEAN, MYNETS LOCAL [10.0.33.97] [10.0.33.97] <admin@xxx> -> <test@utk.ru>, Message-ID:
    <op.vabkeky64azo2s@xxxx>, mail_id: JuXSLFZgb25C, Hits: 1.356, size: 666, queued_as: C2C0F44494A, 5737 ms
    Mar 29 13:56:28 mail postfix/smtp[64989]: EA59E4448C8: to=<test@utk.ru>, relay=127.0.0.1[127.0.0.1]:10024, delay=8.9, delays=3.1/0.02/0.01/5.7, dsn=2.0.0,
    status=sent (250 2.0.0 from MTA([127.0.0.1]:10025): 250 2.0.0 Ok: queued as C2C0F44494A)
    Mar 29 13:56:28 mail postfix/smtp[64994]: C2C0F44494A: to=<test@e1.ru>, relay=saturn.mplik.ru[195.58.1.78]:25, delay=0.06, delays=0.01/0.02/0.01/0.02, dsn=4.1.8
    status=deferred (host saturn.mplik.ru[195.58.1.78] said: 450 4.1.8 <admin@xxx>: Sender address rejected: Domain not found (in reply to RCPT TO command))
    Письму последовательно присваивается 2 id. если запустить скрипт, то он в столбец status занесет только
    Код (Text):
    =sent (250 2.0.0 from MTA([127.0.0.1]:10025): 250 2.0.0 Ok: queued as C2C0F44494A
    . Надо, чтобы еще заносил и
    Код (Text):
    =deferred (host saturn.mplik.ru[195.58.1.78] said: 450 4.1.8 <admin@xxx>: Sender address rejected: Domain not found (in reply to RCPT TO command)
    . Но оно заполняется, если только вручную удалить письмо из очереди.

    Вот сам скрипт:



    Код (Text):
    #!/usr/local/bin/perl

    use DBI;

    $dbh = DBI->connect("DBI:mysql:host=localhost;database=maillogs","mailuser","mailuser")
    or die "Нет доступа к СУБД!";
    #$insert = "INSERT INTO mails (id,year,month,day,time,ip,mailfrom,rcptto,size) VALUES(?,?,?,?,?,?,?,?,?)";
    $insert = "INSERT INTO mails (id,year,month,day,time,ip,mailfrom,rcptto,size,status) VALUES(?,?,?,?,?,?,?,?,?,?)";
    $sth = $dbh->prepare("$insert");

    my %rec;
    my %test;
    open(MAIL, "/var/log/maillog");
    while ($line = <MAIL>)
    {
    my ($month, $day, $time, $hostname, $servicename, $id, $message) = split /\s+/, $line, 7;
    # if ($id =~ /([a-z0-9]+)\:/i)
    if ($id =~ /([A-Z0-9]+)\:/)
    {
    $id = $1;
    $rec{$id} = {}
    unless ($rec{$id}); #unless expr Оператор выполняется, если выражение expr ложно.


    if ($message =~ 'removed')
    {
    $rec{$id}->{'removed'}++;
    }
    else
    {
    while ($message =~ /(client|size|from|to)=(\S+?)(\s|,)/g)
    {
    #                                 {
    if ($1 eq 'client') {
    $rec{$id}->{'month'} = sprintf "%s", $month;
    $rec{$id}->{'day'} = sprintf "%d", $day;
    $rec{$id}->{'time'} = sprintf "%s", $time;
    }
    $rec{$id}->{$1} = $2;
    #       print $rec{$id}->{$1};
    #print $rec{$id};

    #                                 }
    }

    # здесь хочу сделать проверку - если после status=deferred, то $rec{$id}->{'status'} присваиваю $3, если нет - то $1
    #для 1-го id одного письма со статусом deferred должно сначала работать 2-ое выражение, для 2-го id - первое выражение НО НЕ РАБОТАЕТ
    # if ($message =~ /(status=deferred)(\s)(.+)/g)
    #               {
    #             $rec{$id}->{'status'} = $3;
    #             print "$rec{$id}->{'status'}\n";
    #             print $3;
    #               }

    if ($message =~ /status=(.+)/g)
    # elsif ($message =~ /status=(.+)/g)
    {
    $rec{$id}->{'status'} = $1;
    #             print "$rec{$id}->{'status'}\n";
    }




    }
    }


    #здесь хотел по аналогии сделать для случая status=deferred
    #status=deferred
    my ($month, $day, $time, $hostname, $servicename, $id, $message) = split /\s+/, $line, 7;
    if ($ide =~ /([A-Z0-9]+)\:/)
    {
    $ide = $1;
    $test{$ide} = {}
    unless ($test{$ide}); #unless expr Оператор выполняется, если выражение expr ложно.

    #   if ($message =~ 'removed')
    #            {
    #    $test{$ide}->{'removed'}++;
    #            }
    }
    #  else                                     {
    while ($message =~ /(status=deferred)(\s)(.+)/g)
    {
    if ($1 eq 'status=deferred') {
    $test{$ide}->{'month'} = sprintf "%s", $month;
    $test{$ide}->{'day'} = sprintf "%d", $day;
    $test{$ide}->{'time'} = sprintf "%s", $time;
    }
    #       print "$test{$ide}->{'time'"};
    $test{$ide}->{$1} = $3;
    #        print $1; # ключ хеша - status=deferred - отображается
    #        print $test{$ide}->{$1}; #вывод строки после status=deferred - отображается
    #        }


    }


    close(MAIL);


    foreach my $ide (sort { $test{$a}->{'time'} cmp $test{$b}->{'time'} } keys %test)
    # foreach my $ide ( keys %test)
    {
    #                     print $test{$ide}; - не отображается
    #                     print $test{$ide}->{$1};
    $test{$ide}->{'client'} =~ s/(.+)\[(\d+\.\d+\.\d+\.\d+)\]/$3/;
    $test{$ide}->{'from'} =~ s/<(.+)>/$1/;
    $test{$ide}->{'to'} =~ s/<(.+)>/$1/;

    #   if ($test{$ide}->{'removed'})




    print "$test{$ide}->{'to'}";
    }


    ($year) = (localtime)[5];
    $timy = ("%02d\n", $year + 1900);

    foreach my $id (sort { $rec{$a}->{'time'} cmp $rec{$b}->{'time'} } keys %rec) #переменной $id поочередно присваиваются
    #значения всех элементов списка, возвращаемого keys %rec (keys используется для получения списка ключей хеша)
    #для отображения элементов хеша - $rec{$id}
    #слева от стрелки - ссылка на хеш, справа - значение ключа, помещенное в фигурные скобки
    #$rec{$id}->{'client'} - слева от стрелки ссылка на хеш, справа - значение ключа, результат - значение хеша
    {
    # print "$rec{$id}->{'client'}";
    # print $rec{$id};
    $rec{$id}->{'client'} =~ s/(.+)\[(\d+\.\d+\.\d+\.\d+)\]/$2/;
    $rec{$id}->{'from'} =~ s/<(.+)>/$1/;
    $rec{$id}->{'to'} =~ s/<(.+)>/$1/;
    # $rec{$id}->{'status'} =~ s/<(.+)>/$3/;
    #  print $rec{$id}->{'status'};
    if (
    $rec{$id}->{'removed'}
    #    &&
    #    $rec{$id}->{'client'} ne '127.0.0.1'
    )
    {
    if ($rec{$id}->{'from'} ne 'root@mail.utk.su' || $rec{$id}->{'from'} ne 'virusalert@utk.su' || $rec{$id}->{'to'} ne 'virusalert@utk.su')
    {
    $sth1 = $dbh->selectrow_arrayref("SELECT COUNT(*) FROM mails");
    $iddt = "$sth1->[0]";
    $idd = $iddt + 1;
    #  $sth->execute($idd,$timy,$rec{$id}->{'month'},$rec{$id}->{'day'},$rec{$id}->{'time'},$rec{$id}->{'client'},$rec{$id}->{'from'},$rec{$id}->{'to'},$rec{$id}
    $sth->execute($idd,$timy,$rec{$id}->{'month'},$rec{$id}->{'day'},$rec{$id}->{'time'},$rec{$id}->{'client'},$rec{$id}->{'from'},$rec{$id}->{'to'},$rec{$id}
    }
    }
    }





    $sth1->finish;
    $sth->finish;
    $dbh->disconnect;

    Добавлено: Помогите подправить скрипт, чтобы он заполнял поле status (то есть когда сообщение висит в очереди)

    Кратко что скрипт делает:
    1) Открывается журнальный файл maillog, находящийся в каталоге /var/log/;
    2) В скалярную переменную $line последовательно в цикле помещается каждая строка журнала;
    3) С помощью функции split строка дробится на составляющие элементы;
    4) Выделение нужной информации основано на поиске Message-ID, который уникален для
    каждого обрабатываемого письма;
    5) Также исключается учет писем от различных служб на заданный ящик.
     
Загрузка...
Похожие Темы - Perl Script анализа
  1. ProFTP
    Ответов:
    0
    Просмотров:
    3.532
  2. AnaStas
    Ответов:
    0
    Просмотров:
    1.679
  3. AnaStas
    Ответов:
    6
    Просмотров:
    3.997
  4. AnaStas
    Ответов:
    1
    Просмотров:
    2.958
  5. Anna_Kashina
    Ответов:
    0
    Просмотров:
    138

Поделиться этой страницей