Как я могу загружать почтовые вложения IMAP через SSL и сохранять их локально с помощью Perl?

Мне нужны предложения о том, как я могу загружать вложения из моих писем IMAP, в которых есть вложения и текущая дата в строке темы, т.е. в формате YYYYMMDD, и сохранять вложения по локальному пути.

Я просмотрел модуль Perl Mail::IMAPClient и могу подключиться к Почтовый сервер IMAP, но нужна помощь по другим задачам. Еще одна вещь, на которую следует обратить внимание, это то, что для моего IMAP-сервера требуется SSL-аутентификация.

Также вложения могут быть файлами gz, tar или tar.gz.


person Space    schedule 16.03.2010    source источник
comment
вы можете попробовать это: phocean.net/2007/06/03/   -  person ghostdog74    schedule 16.03.2010
comment
Спасибо, это здорово. Не могли бы вы также предложить, есть ли возможность включить аутентификацию SSL.   -  person Space    schedule 16.03.2010


Ответы (4)


Простая программа, которая делает то, что вы хотите, приведена ниже.

#! /usr/bin/perl

use warnings;
use strict;

Минимальная версия для Email::MIME предназначена для того времени, когда была введена walk_parts.

use Email::MIME 1.901;
use IO::Socket::SSL;
use Mail::IMAPClient;
use POSIX qw/ strftime /;
use Term::ReadKey;

Вы ведь не хотите жестко запрограммировать свой пароль в своей программе, не так ли?

sub read_password {
  local $| = 1;
  print "Enter password: ";

  ReadMode "noecho";
  my $password = <STDIN>;
  ReadMode "restore";

  die "$0: unexpected end of input"
    unless defined $password;

  print "\n";
  chomp $password; 
  $password;
}

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

my $pw = read_password;
my $imap = Mail::IMAPClient->new(
 #Debug    => 1,
  User     => "you\@domain.com",
  Password => $pw,
  Uid      => 1,
  Peek     => 1,  # don't set \Seen flag
  Socket   => IO::Socket::SSL->new(
                Proto    => 'tcp',
                PeerAddr => 'imap.domain.com',
                PeerPort => 993,
              ),
);

die "$0: connect: $@" if defined $@;

Если вам нужна папка, отличная от папки «Входящие», измените ее.

$imap->select("INBOX")
  or die "$0: select INBOX: ", $imap->LastError, "\n";

С помощью поиска IMAP ищем все сообщения, темы которых содержат сегодняшнюю дату в формате ГГГГММДД. Дата может быть в любом месте темы, например, тема «foo bar baz 20100316» будет соответствовать сегодняшнему дню.

my $today = strftime "%Y%m%d", localtime $^T;
my @messages = $imap->search(SUBJECT => $today);
die "$0: search: $@" if defined $@;

Для каждого такого сообщения записывайте его вложения в файлы в текущем каталоге. Мы пишем самый внешний слой вложений и не копаемся в поисках вложенных вложений. Часть с параметром имени в типе содержимого (как в image/jpeg; name="foo.jpg") считается вложением, и мы игнорируем все остальные части. Имя сохраненного вложения состоит из следующих компонентов, разделенных символом -: сегодняшняя дата, идентификатор сообщения IMAP, индекс позиции в сообщении, основанный на единице, и имя.

foreach my $id (@messages) {
  die "$0: funky ID ($id)" unless $id =~ /\A\d+\z/;

  my $str = $imap->message_string($id)
    or die "$0: message_string: $@";

  my $n = 1;
  Email::MIME->new($str)->walk_parts(sub {
    my($part) = @_;
    return unless ($part->content_type =~ /\bname=([^"]+)/ 
                or $part->content_type =~ /\bname="([^"]+)"/); # " grr...

    my $name = "./$today-$id-" . $n++ . "-$1";
    print "$0: writing $name...\n";
    open my $fh, ">", $name
      or die "$0: open $name: $!";
    print $fh $part->content_type =~ m!^text/!
                ? $part->body_str
                : $part->body
      or die "$0: print $name: $!";
    close $fh
      or warn "$0: close $name: $!";
  });
}
person Greg Bacon    schedule 16.03.2010
comment
Спасибо Gbacon за краткие подробности с кодом. Мне нужна еще одна помощь. С вашим кодом я могу скачать только текстовые вложения. Не могли бы вы также сообщить об изменениях, если я также хочу загрузить файлы .tar.gz или gz. - person Space; 19.03.2010
comment
@Octopus В типах содержимого сжатых вложений отсутствуют атрибуты имени? - person Greg Bacon; 19.03.2010
comment
да, в сжатых вложениях не отображается имя вложения. - person Space; 22.03.2010
comment
@Octopus Трудно дать хорошее предложение, не зная, как форматируются сообщения. Что такое Content-Type у сжатого gzip-вложения? (Обычно это application/octet-stream или application/x-gzip.) Генерируются ли эти сообщения машиной и форматируются ли они последовательно? Имеют ли сообщения другой составной контент? Можете ли вы отредактировать свой вопрос, чтобы добавить образец сообщения с исключенными данными base64? - person Greg Bacon; 29.03.2010
comment
Просто чтобы добавить больше для этого ответа. Я обнаружил, что некоторые из ваших поставщиков имеют поддельные почтовые серверы, а атрибут имени идет без кавычек, например Content-Type: application/pdf; name=065011-5.PDF, поэтому $part->content_type =~ следует изменить на /\bname=([^"]+)/;. - person ; 21.01.2016

Если вы хотите придерживаться Mail::IMAPClient, вы можете указать использовать SSL.

Альтернативно, Net::IMAP::Simple::SSL тоже мог бы тебе в этом помочь. Интерфейс такой же, как у Net::IMAP::Simple< /а>.

Получив сообщение, Анализ электронных писем с вложениями показывает, как извлечь вложения. Я не пробовал, но подозреваю, что с помощью Email::MIME:: walk_parts можно использовать для значительного упрощения сценария, показанного в той статье PerlMonks.

person Sinan Ünür    schedule 16.03.2010

Я немного изменил свой подход к загрузке вложений от @Greg, поскольку было показано, что загрузка вложений SAP XML ненадежна. Они не следуют стандарту Content-Type: application/pdf; name=XXXXX, поэтому у меня было много проблем. Пример:

Content-ID: <[email protected]>
Content-Disposition: attachment;
    filename="XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml"
Content-Type: application/xml
Content-Descripton: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml

В остальном программа остается почти такой же. Разница в том, что теперь я использую MIME::Parser для извлечения всего сообщения и выбрасываю все, что связано с телом и изображением. Я также удалил Peek => 1, так как хотел пометить сообщения как прочитанные после их загрузки (и перемещаться только по непрочитанным сообщениям). Log::Logger помог создать централизованный журнал:

--- Фрагмент 1 --- Библиотеки

#! /usr/bin/perl
use warnings;
use strict;
use Mail::IMAPClient; #IMAP connection
use Log::Logger; #Logging facility
use MIME::Parser; #Mime "slicer"
use DateTime; #Date
use File::Copy; #File manipulation
use File::Path qw( mkpath );

--- Фрагмент 2 --- Инициализация журнала

$log_script = new Log::Logger;
$log_script->open_append("/var/log/downloader.log");
my $dt = DateTime->now;
$dt->set_time_zone('America/Sao_Paulo');
$hour = (join ' ', $dt->ymd, $dt->hms);

--- Фрагмент 3 --- Загрузчик почты

$imap->select($remote_dir) or ($log_script->log("$hour: Account $account, Dir $remote_dir. Check if this folder exists") and next);
# Select unseen messages only
my @mails = ($imap->unseen);
foreach my $id (@mails) {
  my $subject = $imap->subject($id);
  my $str = $imap->message_string($id) or ($log_script->log("$hour: Account $account, Email \<$subject\> with problems. Crawling through next email") and next);
  my $parser = MIME::Parser->new();
  $parser->output_dir( $temp_dir );
  $parser->parse_data( $str );
  opendir(DIR, $temp_dir);
  foreach $file (readdir(DIR)) {
    next unless (-f "$temp_dir/$file");
    if ("$file" =~ /^msg/i){ # ignores body
      $body .= "$file ";
      unlink "$temp_dir/$file";
    } elsif (("$file" =~ /jpg$/i) # ignores signature images
          or ("$file" =~ /gif$/i)
          or ("$file" =~ /png$/i)) {
      $body .= "$file ";
      unlink "$temp_dir/$file";
    } else { # move attachments to destination dir
      $log_script->log("$hour: Account: $account, File $file, Email \<$subject\>, saved $local_dir");
      move "$temp_dir/$file", "$local_dir";
    };
 };
  $log_script->log("$hour: Files from email \<$subject\> ignored as they are body related stuff: $body") if $body;
person Community    schedule 26.01.2016

Я предпочитаю подход Mail::IMAPClient, описанный Грегом, но важно binmode() дескриптор выходного файла, а именно, чтобы Windows не принимала байты 0x0A за символы перевода строки и заменяла их на CRLF, тем самым делая двоичные файлы недействительными. Мне жаль замаскировать это под ответ, комментарии были бы уместны, но у меня пока нет репутации.

person FIFO    schedule 07.06.2018
comment
Немецкий? (шучу, но не надо оправдываться). Добро пожаловать в StackOverflow! - person Adrian W; 08.06.2018
comment
Как ты мог знать? Я старался изо всех сил, чтобы это звучало по-датски :) - person FIFO; 08.06.2018
comment
Когда я впервые ступил на территорию США и спросил таксиста, довезет ли он меня от одного терминала JFK до другого, первое слово водителя было немецким? С тех пор я знаю, что немцы известны тем, что оправдываются или спрашивают таксиста, может ли он выполнять свою работу. Вернемся к SO: можно опубликовать ответ. Период. Вам не нужно оправдываться, даже если вы считаете, что комментарий был бы более уместным. - person Adrian W; 08.06.2018