![]() |
Внимание, важное сообщение: Дорогие Друзья!
В ноябре далекого 2001 года мы решили создать сайт и форум, которые смогут помочь как начинающим, так и продвинутым пользователям разобраться в операционных системах. В 2004-2006г наш проект был одним из самых крупных ИТ ресурсов в рунете, на пике нас посещало более 300 000 человек в день! Наша документация по службам Windows и автоматической установке помогла огромному количеству пользователей и сисадминов. Мы с уверенностью можем сказать, что внесли большой вклад в развитие ИТ сообщества рунета. Но... время меняются, приоритеты тоже. И, к сожалению, пришло время сказать До встречи! После долгих дискуссий было принято решение закрыть наш проект. 1 августа форум переводится в режим Только чтение, а в начале сентября мы переведем рубильник в положение Выключен Огромное спасибо за эти 24 года, это было незабываемое приключение. Сказать спасибо и поделиться своей историей можно в данной теме. С уважением, ваш призрачный админ, BigMac... |
|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Скриптовые языки администрирования Windows » Любой язык - Perl:Помогите отредактировать Скрипт |
|
Любой язык - Perl:Помогите отредактировать Скрипт
|
Старожил Сообщения: 362 |
Скрипт выдергивает Аттач из писем и раскладывает его по папкам.
#!/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 .... Наглая просьба, подскажите пожалуйста, что нужно поправить в скрипте, чтобы он изменял формат Второго письма на формат первого. |
|
------- Отправлено: 16:13, 16-12-2009 |
![]() |
Участник сейчас на форуме |
![]() |
Участник вне форума |
![]() |
Автор темы |
![]() |
Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
Разное - как привратить bat файл в скрипт perl | user171078 | Программирование и базы данных | 1 | 20-01-2010 12:09 | |
FreeBSD 5.3 Perl не видит локали, а KDE при сборке не видит perl :o | mar | Общий по FreeBSD | 8 | 06-05-2005 13:13 | |
Помогите найти ошибку в трёх строках (perl) | Guest | Вебмастеру | 9 | 30-06-2004 12:57 | |
Не работает скрипт на Perl | Rudy | Вебмастеру | 1 | 18-06-2004 19:22 | |
Помогите установить Perl-скрипт | RAY | Вебмастеру | 5 | 29-09-2003 17:42 |
|