Perl:Помогите отредактировать Скрипт
Скрипт выдергивает Аттач из писем и раскладывает его по папкам.
Код:
#!/usr/bin/perl
use 5.8.0;
use strict;
use Net::POP3;
#use Convert::Cyr qw(chcp);
use MIME::Base64;
use MIME::QuotedPrint;
use Getopt::Long qw(GetOptions);
use Data::Dumper;
use Encode;
#use Date::Calc;
my(%t, %opt);
GetOptions(
\%t,
'parfile=s', 'testfile=s');
die "\nspecify parameter file: <path to perl.exe> get_mail.pl -parfile=<param file name>\n" unless ($t{parfile} || $t{testfile});
my $mails;
if ($t{parfile}) {
#чтение опцый
open PAR, "$t{parfile}" || die "error opening file $t{parfile}\n";
while (my $l=<PAR>) {
chomp $l;
if ($l=~/(.+)=(.+)/) {
$opt{lc($1)}=$2;
}
}
#проверка опций
die "specify SMTP server\n" unless $opt{'smtp_server'};
die "specify output dir prefix\n" unless $opt{'subprefix'};
$opt{'clearflag'} = uc($opt{'clearflag'}) eq "Y" ? "Y" : "N";
#чтение писем из pop3-яшшыка
$mails = get_mails_from_pop3(\%opt);
} elsif ($t{testfile}) {
$opt{subprefix}="TESTING";
$opt{debug}="Y";
open TESTFILE, $t{testfile} || die "can\'t open file $t{testfile}\n : ".$!;
# local undef $/;
my $cnt;
$cnt.=$_ while(<TESTFILE>);
close TESTFILE;
my @m;
push @m, parse_mail($cnt);
$mails = \@m;
} else {
die "no parameters to process. stop\n";
}
close PAR;
#print Data::Dumper::Dumper([\%opt]);
#exit(0);
#### read mail
#### parse mail
my $msg=0;
foreach my $mail (@{$mails}){
$msg++;
my $dir = $opt{subprefix}.$msg;
unless (-d "$dir") {
mkdir "$dir"
}
my $f=0;
foreach my $file (@{$mail->{'files'}}){
open FILE, ">"."$dir/".$file->{name} or next;
binmode FILE;
print FILE $file->{'file'};
close FILE;
}
}
printf "Received messages:%d\n",$msg;
#------------------------------------
sub get_mails_from_pop3{
my ($opt)=@_;
my $debug;# = 1 if $opt->{'test'};
my $pop = Net::POP3->new($opt->{'smtp_server'}, Timeout => 60, Debug=> $debug) or die "Can not create new POP3 mail \n";
my $auth=$pop->login($opt->{'login'},$opt->{'password'});
die "POP3: Not authenticated\n" unless $auth;
my $list=$pop->list();
#---------- Only list with messages
return $list if $opt->{'list'};
my @messages;
if($list){
foreach my $num (keys %{$list}){
my $message = $pop->get($num);
my $letter ='';
if ($message){
foreach (@{$message}){
$letter .=$_;
}
printf "reading msg %d\n", $num if $opt{debug} eq "Y";
#дампим в фаел
if ($opt{dumpraw} eq "Y") {
open RAW, ">rawmsg".$num;
print RAW $letter;
close RAW;
}
push @messages, parse_mail($letter);
}
$pop->delete($num) if $opt->{'clearflag'} eq "Y";
}
}
$pop->quit();
return \@messages;
}
#--------------------------------------
sub parse_mail{
my ($letter) = @_;
my $header = $1 if $letter=~/^(.*?)\n\n(.*?)$/s;
my (%mail, @files, $boundary);
$mail{from} = $1 if $header =~m/^From:\s*(.*)$/m;
$mail{from} ||= 'anonymous';
$mail{name} = $1 if $mail{from} =~m/(.*?)\s(.*)$/;
if (! $mail{name}){
$mail{name} ||= $1 if $mail{from} =~m/(.*?)\@(.*)$/;
}
$mail{subject} = $1 if $header =~ m/^Subject:\s*(.*)$/m;
$mail{content_type} = $1 if $header =~ m/^Content-Type:\s*(.*)/m;
$boundary = '--'.$1 if($letter =~ m/boundary="(.*)"$/m);
if ($mail{content_type} =~ m|multipart|) { #1
if ($mail{content_type} =~ m|mixed|) { #2
if ($letter =~ m/boundary="(.*)"$/m){ #3
$boundary = '--'.$1;
$letter =~ m/[^"]$boundary(.*)/s;
my @arr = split $boundary, $1;
printf STDERR "message from: %s\n", $mail{from} if $opt{debug} eq "Y";
printf STDERR "multipart message of %d pieces\n", scalar(@arr) if $opt{debug} eq "Y";
foreach my $item (@arr) {
if ($item =~ m/filename=/m) {
my %hash;
#определение имени файла
if ($item =~ m|filename="?(.+?)"?$|sm) {
my $filename = $1;
if ($filename =~ m|\?B\?|) {
#зокодировано как MIME
$hash{name}=deMIME($filename);
printf STDERR "filename:%s, decoded:%s\n", $filename, $hash{name} if $opt{'debug'} eq "Y";
} else {
#не кодировано
$hash{name}=$filename;
printf STDERR "filename=%s\n", $filename if $opt{'debug'} eq "Y";
}
} else {
die "Can\'t read file name\n";
}
$hash{content_type} = $1 if $item=~ m/^Content-Type:\s*(.*);/im;
if ($item =~ m/^Content-Transfer-Encoding:\sbase64$/im) {
$hash{file} = $1 if $item =~ m/\n\n(.*)\n$/s;
$hash{file} = decode_base64($hash{file});
} elsif ($item =~ m/^Content-Transfer-Encoding:\squoted-printable$/im) {
$hash{file} = $1 if $item =~ m/\n\n(.*)\n\n$/s;
$hash{file} = decode_qp($hash{file});
} else {
$hash{file} = $1 if $item =~ m/\n\n(.*)\n\n$/s;
}
push @files, \%hash if $hash{name};
printf STDERR "file size: %d\n", length($hash{file}) if $opt{debug} eq "Y";
}
}
} #3
} #/2
} elsif ($mail{content_type}=~m|application\/octet-stream|i && $header =~ m|content-disposition:\s+?inline|mi) {#/1
#пытаемся понять - не странное ли это письмо, которое состоит из одного bodypart с Content-Disposition: inline
$mail{content_transfer_encoding} = $1 if $header =~ m|Content-Transfer-Encoding:\s+?(.+)|m;
my %hash;
if ($header =~ m|filename="?(.+?)"?$|sm) {
#разбор с именем файла
my $filename = $1;
if ($filename =~ m|\?B\?|) {
#зокодировано как MIME
$hash{name}=deMIME($filename);
printf STDERR "filename:%s, decoded:%s\n", $filename, $hash{name} if $opt{'debug'} eq "Y";
} else {
#не кодировано
$hash{name}=$filename;
printf STDERR "filename=%s\n", $filename if $opt{'debug'} eq "Y";
}
#содержымое файла
if ($letter =~ m|.+\n\n(.+)\n$|s) {
my $body = $1;
if (lc($mail{content_transfer_encoding}) eq "base64") {
$hash{file} = decode_base64($body);
} elsif (lc($mail{content_transfer_encoding}) eq "quoted-printable") {
$hash{file} = decode_qp($body);
} else {
die "Can\'t read file: unknown transfer-encoding method\n";
}
} else {
die "Can\'t read message body - malformed?\n";
}
push @files, \%hash;
} else {
die "Can\'t read file name in single-part message!\n";
}
} #1
$mail{files} = \@files;
# print Data::Dumper::Dumper(\%mail);
# exit;
return \%mail;
}
#---------------------------
sub deMIME {
my $mimed = shift;
my $result;
if ($mimed =~ m|=\?.+?\?B\?|) {
while ($mimed =~ m|=\?(.+)\?B\?(.+)\?=|g) {
my $enc = $1;
my $body = decode_base64($2);
if (lc($enc) eq "koi8-r") {
Encode::from_to($body, "koi8-r", "cp1251");
}
$result .= $body;
}
} else {
$result = $mimed;
}
return $result;
}
с некоторого времени он перестал выдирать Аттач из писем с определенного сервера.
Путем копаний пришел к выводу,что причина в кодировке письма.
Пример заголовка письма, аттач которого принимается.
Код:
Received: from --- ([10.10.1.22]) by --- with Microsoft SMTPSVC(6.0.3790.1830);
Wed, 16 Dec 2009 15:03:03 +0300
Date: Wed, 16 Dec 2009 15:03:03 +0300
From: tsreport <tsreport@---.ru>
X-Mailer: The Bat! (v1.62 Christmas Edition) Personal
Reply-To: tsreport <tsreport@---.ru>
X-Priority: 3 (Normal)
Message-ID: <63624069828.20091216150303@---.ru>
To: ---
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----------D91C53244750CC"
Return-Path: ---
X-OriginalArrivalTime: 16 Dec 2009 12:03:03.0617 (UTC) FILETIME=[B8789B10:01CA7E47]
------------D91C53244750CC
Content-Type: text/plain; charset=Windows-1251
Content-Transfer-Encoding: 8bit
Здравствуйте,
--
С уважением,
tsreport mailto:---
------------D91C53244750CC
Content-Type: application/x-zip-compressed; name="091215_4.zip"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="091215_4.zip"
......
Пример заголовка письма, аттач которого НЕ принимается.
Код:
Received: from --- ([10.10.1.22]) by --- with Microsoft SMTPSVC(6.0.3790.1830);
Wed, 16 Dec 2009 12:53:21 +0300
Date: Wed, 16 Dec 2009 12:53:20 +0300
From: Micex <MC0172300000@--->
X-Mailer: The Bat! (v1.62 Christmas Edition) Personal
Reply-To: Micex <MC0172300000@--->
X-Priority: 3 (Normal)
Message-ID: <112616287656.20091216125320@--->
To: ---
Subject: =?koi8-r?B?RndkOiDrzMnSyc7Hz9fZxSDP1N7F1Nkg2sEgMTUuMTIuMjAwOQ==?=
In-Reply-To: <66C877A6F6A4A348863902DF3E1D3F4C2F45DF227C@--->
References: <66C877A6F6A4A348863902DF3E1D3F4C2F45DF227C@--->
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="----------12ACD338341737"
Return-Path: MC0172300000@---
X-OriginalArrivalTime: 16 Dec 2009 09:53:21.0004 (UTC) FILETIME=[99AC1AC0:01CA7E35]
------------12ACD338341737
Content-Type: text/plain; charset=koi8-r
Content-Transfer-Encoding: 8bit
ъДТБЧУФЧХКФЕ, ---
---------- рЕТЕУЩМБЕНПЕ РЙУШНП ----------
пФ: ьдп <ufookedo@--->
л: <MC0172300000@--->
б ФБЛЦЕ Л:
чТЕНС УПЪДБОЙС: Tue, 15 Dec 2009 20:04:55 +0300
фЕНБ: ПФЮЕФЩ ЪБ 15.12.2009
рТЙЛТЕРМЕООЩЕ ЖБКМЩ: MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e, MC01723_EQR05_00T_151209_004008898.txt.p7s.zip.p7e, MC01723_EQR15_00T_151209_004009111.txt.p7s.zip.p7e, MC01723_EQR19_00T_151209_004009190.txt.p7s.zip.p7e, MC01723_EQM06_00T_151209_004009513.xml.p7s.zip.p7e, MC01723_EQM6C_00T_151209_004009636.xml.p7s.zip.p7e,
mailto:MC0172300000@mars.micex.ru
------------12ACD338341737
Content-Type: application/octet-stream;
name="MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e"
Content-Description: MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e
Content-Disposition: attachment;
filename="MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e"; size=9974;
creation-date="Tue, 15 Dec 2009 20:02:31 GMT";
modification-date="Tue, 15 Dec 2009 20:02:31 GMT"
Content-Transfer-Encoding: base64
....
Я в Perl не понимаю ничего, но Вижу что есть процедура, которая производит Парсинг сообщения и определяет его кодировку, после чего наверно меняет.
Наглая просьба, подскажите пожалуйста, что нужно поправить в скрипте, чтобы он изменял формат Второго письма на формат первого. |
