如何通过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,其在消息中的位置的从一开始的索引及其名称.

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