VPF::Обработка писем (извлеч аттач)

Grost

Дата 27.8.2010, 16:48 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

Здравствуйте.
Такая вот задача. Вытащить вложения из письма. Читал в perldoc про MIME::Entity, MIME::Parser, MIME::Tools. Но, что то тяжко даётся освоение. В доке написано, что с помощью Entity можно прикрепить этот файл, по логике с его же помощью думаю возможно и вытащить, но нигде этого не нашёл. С Parser не смог разобраться, видел тут тему похожую, но там пример не рабочий.
В итоге сделал обработку в ручную, построчно.
В письме есть текстовое вложение, его построчно удалось перегнать в другой файлик. А вложения формата xls таким способом вытащить не получилось. Файл при открытии пишет что повреждён и восстановлению не подлежит.
Закодировано в base64.

Есть у кого-нибудь идеи или опыт, как решить задачку с вытаскиванием xls'ки из письма?)

arto

Дата 27.8.2010, 19:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40

ни письма, ни кода.
телепаты пока в отпуске.

shamber

Дата 27.8.2010, 20:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18

вот кусочки кода из проекта

Код


use MIME::Parser;
use MIME::Words qw(:all);
use File::Path;
use IO::File;

sub new{
    my ($check,%hex) = @_;
    my $proto = ref( $check ) || $check;
    my $self;
    
    foreach my $key( keys %hex){
        $self->{$key} = $hex{$key};
    }
    
    $self->{parser} = new MIME::Parser;
    $self->{parser}->output_under($self->{outdir});
    delete $self->{outdir};
    
    $self->{error}=[];
    $self->{count}=0;
    bless($self,$proto);
    return $self;
}


sub Parce{
    my $self=  shift;
    my $file = shift;
    $self->{entity} = $self->{parser}->parse_open($file);
    $self->DumpAll($self->{entity});
    unless (exists $self->{'xml'}){
        return 0;
    }else{
        return 1;
    }
}

sub DumpAll{
    my $self = shift;
    my $entity = shift;
    my $IO;
    my @parts = $entity->parts;
    if (@parts) {                     # multipart...
    my $i;
    foreach $i (0 .. $#parts) {       # dump each part...
        $self->DumpAll($parts[$i]);
    }
    }
    else {                            # single part...    
    # Get MIME type, and display accordingly...
    my ($type, $subtype) = split('/', $entity->head->mime_type);
    my $body = $entity->bodyhandle;
    if ($type =~ /^(text|message)$/ and $subtype ne 'xml') {     # text: display it...
        if ($IO = $body->open("r")) {
        $self->{message} .= $_ while (defined($_ = $IO->getline));
        $IO->close;
        }
        else {       # d'oh!
        print "$0: couldn't find/open : $!";
        }
    }elsif ($type =~ /^(application|text)/ or $subtype =~ /xml/i){
        if (defined $entity->head->recommended_filename){
        if($entity->head->recommended_filename =~/.xml$/i){
            $self->{count}++;
            $self->{'xml'}->{$self->{count}}= $body->path;
        }
        
        }
        }
    }

dva300

Дата 27.8.2010, 20:29 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 220
Регистрация: 17.2.2010
Где: Москва

Репутация: -1
Всего: 1

идеи есть, тема интересная. нужное подчеркнуть

1. Unix
  1.1. парсим письма online на основе файла aliace - robot : path/your_prg.pl |
  1.2. парсим хранилище пользовательских сообщений offline , например по cron

2. Windows
  2.1. парсим пользвательские файлы типа eml, pst...
  2.2. online на скрипт (думаю Microsoft тут утиль какую-нибудь уже сделал)

что именно вам нужно ?

--------------------

Участник движения Культура Вождения

NuINu

Дата 28.8.2010, 07:46 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 131
Регистрация: 19.7.2008

Репутация: 5
Всего: 6

на что обратил внимание, автор упоминает требование прочитать xls, в коде читает xml

Grost

Дата 28.8.2010, 11:48 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

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

собственно кусок который декодит:

Код


use MIME::Base64;

open MS, "< C:/mail/mail.txt" or die "";
open SF, ">> C:/mail/404.txt" or die"";
@dec1 = decode_base64(<MS>); foreach(@dec1){print SF $_};
close SF;
close MS;

На перле не очень давно пишу, да и это просто проба модуля, поэтому код корявенький))
Прикладываю часть письма.

Это сообщение отредактировал(а) Grost - 28.8.2010, 11:53

Присоединённый файл ( Кол-во скачиваний: 9 )

mail.txt 22,30 Kb

dva300

Дата 28.8.2010, 13:30 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 220
Регистрация: 17.2.2010
Где: Москва

Репутация: -1
Всего: 1

вы откуда взяли этот base64 документ ? дайте полностью письмо

код у вас не правильный потому и не выводит. нужно примерно так уд тогда

Код


use MIME::Base64;
open(FF1,"mail.txt") or die "$!\n";
open(FF2,">mail.xls")or die "$!\n";
binmode(FF2);
while(<FF1>)
    {
    my $str = decode_base64($_); 
    print FF2 $str;
    }
close(FF1);
close(FF2);

binmode для таких файлов в windows обязательно.

Цитата

@dec1 = decode_base64(<MS>)

вообще ерунда.

но файл все равно кривой получается (но читается - циферки какие-то есть)
возможножно вы не правильно base64 сформировали.

--------------------

Участник движения Культура Вождения

Grost

Дата 28.8.2010, 14:39 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

По поводу расширения файла это да, просто тут рабочий вариант для текстового файла. Попробую вечерком этот вариант.
Просто у меня была заморочка с текстовым файлом, когда он его по строкам читает там не совсем правильно полцучается из за символа перехода на новую строку. Мне кажется что если строка обрывается он её не совсем правильно обрабатывает.
А то что списочная и скалярная переменная, это большой роли думаю не сыграет. Только если выделяемый объем памяти, но на тесте он мне не критичен.

Файл у меня с работы, там инфа по счетам клиентов, как то в целях безопасности не охото всё это сюда выкладывать(

shamber

Дата 28.8.2010, 14:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18

NuINu, xml заменить на xls не так долго.

dva300

Дата 28.8.2010, 15:13 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 220
Регистрация: 17.2.2010
Где: Москва

Репутация: -1
Всего: 1

Цитата

Файл у меня с работы, там инфа по счетам клиентов, как то в целях безопасности не охото всё это сюда выкладывать(

мы еще и тестируем на битом файле smile

прогоните процедуру на других данных.
я взаял тупо в лоб и вырезал из письма кисок вложения в base64 касательно вложения - процедура работала правильно.

про конец строки см binmode

Цитата

А то что списочная и скалярная переменная, это большой роли думаю не сыграет.

см описание decode_base64

Это сообщение отредактировал(а) dva300 - 28.8.2010, 15:31

--------------------

Участник движения Культура Вождения

Grost

Дата 28.8.2010, 15:36 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

Цитата(dva300 @ 28.8.2010, 15:13

)

мы еще и тестируем на битом файле

ну он не битый.. просто кусочек smile

хех... на ноуте еще и перл не установлен) как поставлю протестирую smile

Это сообщение отредактировал(а) Grost - 28.8.2010, 15:42

dva300

Дата 28.8.2010, 15:41 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 220
Регистрация: 17.2.2010
Где: Москва

Репутация: -1
Всего: 1

Цитата

ну он не битый.. просто кусочек smile

5-ть балов smile

так и надо - что бы не расслаблялись smile

--------------------

Участник движения Культура Вождения

Grost

Дата 28.8.2010, 21:02 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

dav300, огромное спасибо! Всё расшифровалось так как надо. Т.е. вся загвоздка у меня была в функции binmode? Если я буду переносить это на *никс, что там может измениться?

dva300

Дата 29.8.2010, 08:24 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 220
Регистрация: 17.2.2010
Где: Москва

Репутация: -1
Всего: 1

большое ПЖ.
нет, на Unix binmode не нужно.

--------------------

Участник движения Культура Вождения

Grost

Дата 3.9.2010, 14:33 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 65
Регистрация: 26.8.2010
Где: Москва

Репутация: нет
Всего: нет

Вот такой код получился:

Код


#!usr/bin/perl
use MIME::Base64;

...

opendir DM, $dir_msg or die "1 $!\n";
@file_dir=readdir DM;        #-- считываем содержимое директории
open LF, ">> $log" or die "2 $!\n";
shift @file_dir; shift @file_dir;    
foreach(@file_dir){
   $file_msg=$dir_msg.$_;
   #открываем файл письма
   open MS, "$file_msg" or die "3 $!\n";
   while(<MS>){
     if(m/^Return-Path: </){$_=~ s/Return-Path: <|>//;$kod=&ZZZZ($_);    #-- функция считывающая код подразделений
          }
        #-- Ищим совпадения в строках, если находим имя файла, вырезаем его. 
     if(m/filename/i){$_=~ s/(\s*)filename="|"$//g;
        #-- вызываем функцию
        @f_name=&ScToStr($_);

        #-- задаём путь для создания файла
        if($f_name[2] eq '.txt'){my $txt_name="$f_name[0]"."_"."$kod"."$f_name[1]"."$f_name[2]";
            $way="$dir_save_txt"."$txt_name"};
        if($f_name[2] eq '.xls'){my $xls_name="$f_name[0]"."$f_name[1]"."$f_name[2]";
                mkdir "$dir_save_xls"."$kod", 0755 or die "1->mk: $@";
                mkdir "$dir_save_xls"."$kod"."/"."$f_name[0]", 0755 or die "2->mk: $@";
                $way="$dir_save_xls"."$kod"."/"."$f_name[0]"."/"."$xls_name";};

        #-- создаём/открываем файл для записи
        eval{open SM, ">> $way" or die "4 $!\n"};

        #-- если при открытии ошибок не было, обрабатываем дескриптор
        unless($@){print LF $_;$@=shift};

        #-- переходим к следующей итерации
        next};
     #если строка пустая, заканчваем обработку данных, закрываем дескриптор
     if($_ eq '\n'){$way=shift;close SM;next};
     #дешифруем данные из письма
     if($way){$str=decode_base64($_);print SM $str;};
  }
close MS;
}
closedir DM;

В винде эта штука работает, при переносе в *никс пишет так:

Цитата

Setuid/gid script is writable by world

Это сообщение отредактировал(а) Grost - 3.9.2010, 14:36

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »