LINUX.ORG.RU

mail and perl


0

0

Здравствуйте! хочу написать обработчик писем - чтобы при получении письма скрипт проверял текст письма - причем не все а только одного адресата. у меня стоит postfix скажите пожалуйста как настроить чт его чтобы он запускал скрипт при получении письма скажем адресата xxx@xxx.xx или нужно запускать скрипт и чтоб он следил за получением почты? если да то где про это можно почитать...искал разные модули для перла но там ничего интерестного нет (((

anonymous

положи свой perl-скрипт в /etc/smrsh/, потом в /etc/aliases скажи, чтобы
мейл форвардился на этот скрипт:

username: | /etc/smrsh/a.pl

и поста будет сваливаться на STDIN этого скрипта:

#!/usr/bin/perl

while(<>){
$ms.=$_
}
etc...

или при помощи procmailrc (у меня такие настройки для юзера testgcn):

cat /home/testgcn/.forward
|"IFS=' ' && exec /usr/bin/procmail -f- || exit 75 #testgcn"

и

cat /home/testgcn/.procmailrc
:0c
/home/testgcn/log/incoming.mail
UMASK=022
LOGFILE=/home/testgcn/log/procmail.log

:0 : /home/testgcn/log/procmail.lock
* ^Subject.*OTC
| /home/testgcn/public_html/cgi-bin/mail.pl

и

cat /home/testgcn/public_html/cgi-bin/mail.pl

#!/usr/bin/perl

use strict;
use warnings;
use IO::File;
use Getopt::Std;
use MIME::Parser;
use HTML::Parser;
use Unicode::Map8;
use MIME::WordDecoder;
use HTML::Parse;
use HTML::FormatText;
use Mail::Address;

use vars qw($opt_s $opt_u $opt_p $opt_m $wd $e $map);
my $d="/usr/local/etc/httpd/otc/htdocs/circulars";
my $f="/usr/local/etc/httpd/otc/htdocs/circulars/all.txt";
my @m;

do{ push @m => $1 if m~.*/otc(\d+)\.html~ } while(<$d/*.html>);

my @m1 = sort {$a <=> $b} @m;
my $filename=$m1[$#m1]+1;
my $mp = new MIME::Parser;
$mp->ignore_errors(1);
$mp->extract_uuencode(1);

eval { $e = $mp->parse(\*STDIN); };
my $error = ($@ || $mp->last_error);

if ($error) {
$mp->filer->purge; # Get rid of the temp files
die "Error parsing the message: $error\n";
}

# Setup the HTML parser
open F,">$d/otc$filename.html" or die "cant open: $!";

my $parser = HTML::Parser->new (
api_version => 3,
default_h => [ "" ],
start_h => [ sub { print F "[IMG ",
d($_[1]->{alt}) || $_[1]->{src},"]\n" if $_[0] eq 'img';
}, "tagname, attr" ],
text_h => [ sub { print F d(shift); }, "dtext" ],
) or die "Cannot create HTML parser\n";

$parser->ignore_elements(qw(script style));
$parser->strict_comment(1);

sub decode_entities {
my $ent = shift;
if (my @parts = $ent->parts) {
decode_entities($_) for @parts;
}
elsif (my $body = $ent->bodyhandle) {
my $type = $ent->head->mime_type;
setup_decoder($ent->head);
if ($type eq 'text/plain') {
my $txt = d($body->as_string);
$txt=~s/([fh]t?tp.*?)/ <a href="$1" style="text-decoration: none">$1<\/a> /sig;
$txt=~s![\cM\cJ\n]!<br>\n!igs;
print F $txt;
} elsif ($type eq 'text/html') {
my $txt = HTML::FormatText->new->format(parse_html($body->as_string));
$txt=~s/([fh]t?tp.*?)\s/ <a href="$1" style="text-decoration: none">$1<\/a> /sig;
$txt=~s![\cM\cJ\n]!<br>!igs;
print F $txt;
} else { print "Unhandled part\n" }
}
}

$map = Unicode::Map8->new('ASCII') or die "Cannot create character map\n";

setup_decoder($e->head);
my $subj=d($e->head->get('subject'));
$subj=~s!OTC:!!igs;
print F "<pre>";
#print F "Date: ", $e->head->get('date');
#print F "From: ", d($e->head->get('from'));
#print F "To: ", d($e->head->get('to'));
print F "<center><h2>",$subj, "</center></h2>\n";

open C,">>$f" or die "cant open: $!";
$subj=~s!OTC|([\w+\-\.]+\@[\w\-\.]+\.([\w\-\.]+\.)?\w{2,4})!!;
print C "$filename\t$subj";
close C;

print F "</pre>";
decode_entities($e);

$mp->filer->purge;
sub d { $map->to8($map->to16($wd->decode(shift||''))); }

sub setup_decoder {
my $head = shift;
if ($head->get('Content-Type')
and $head->get('Content-Type') =~ m!charset="([^\"]+)"!) {
$wd = supported MIME::WordDecoder uc $1;
}
$wd = supported MIME::WordDecoder "ISO-8859-1" unless $wd;
}

close F;


Правда я еще мейл с аттачами разбирать не умею...
но этот скрипт, вроде бы как согласно всем rfc для почтовых сообщений работает... по крайней мере он режет html...

vilfred ☆☆
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.