如何通过 SSL 下载 IMAP 邮件附件并使用 Perl 将其保存在本地？

Question

我需要有关如何从主题行中包含附件和当前日期（即 YYYYMMDD 格式）的 IMAP 邮件下载附件并将附件保存到本地路径的建议。

我浏览了 Perl 模块 Mail::IMAPClient 并且能够连接到IMAP 邮件服务器，但在其他任务上需要帮助。另一件需要注意的事情是我的 IMAP 服务器需要 SSL 身份验证。

附件也可以是 gz、tar 或 tar.gz 文件。

Answer 1

下面是一个可以完成您想要的操作的简单程序。

#! /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 搜索，我们查找主题包含 YYYYMMDD 格式的今天日期的所有邮件。日期可以位于主题中的任何位置，因此，例如，主题“foo bar baz 20100316”将匹配今天。

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

对于每条此类消息，将其附件写入当前目录中的文件。我们编写附件的最外层，而不挖掘嵌套附件。内容类型中带有 name 参数的部分（如 image/jpeg; name="foo.jpg"）被假定为附件，我们忽略所有其他部分。已保存附件的名称由以下部分组成，以 - 分隔：今天的日期、其 IMAP 消息 ID、其在消息中的位置的基于 1 的索引及其名称。

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: $!";
  });
}

Answer 2

如果您想坚持使用 Mail::IMAPClient，您可以告诉它 < a href="http://search.cpan.org/perldoc/Mail::IMAPClient#Ssl" rel="nofollow noreferrer">使用 SSL。

或者，Net::IMAP::Simple::SSL 也可以帮助你。该接口与 Net::IMAP::Simple< 提供的接口相同/a>.

收到邮件后，解析带附件的电子邮件将显示如何提取附件。我还没有尝试过，但我的直觉是使用 Email::MIME:: walk_parts 可用于显着简化 PerlMonks 文章中显示的脚本。

Answer 3

我稍微改变了从 @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 帮助创建集中式日志：

--- Snippet 1 --- Libs

#! /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 );

--- Snippet 2 --- Log初始化 >

$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;

Answer 4

我更喜欢 Greg 概述的 Mail::IMAPClient 方法，但它对于binmode() 输出文件句柄，即防止 Windows 将 0x0A 字节假定为换行符并用 CRLF 替换它们，从而使二进制文件无效。
我很抱歉将此伪装为答案，评论是适当的，但我现在没有任何声誉。