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

Question

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

我浏览了 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 $@;

对于每条这样的消息，将其附件写入当前目录中的文件。我们写附件的最外层，不挖掘嵌套附件。内容类型中带有名称参数的部分(如 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: $!";
  });
}