Làm cách nào để tải xuống tệp đính kèm IMAP qua SSL và lưu chúng cục bộ bằng Perl?

Question

Tôi cần đề xuất về cách tôi có thể tải xuống tệp đính kèm từ thư IMAP có tệp đính kèm và ngày hiện tại trong dòng tiêu đề, tức là định dạng YYYYMMDD và lưu tệp đính kèm vào đường dẫn cục bộ.

Tôi đã đi qua mô-đun Perl Mail::IMAPClient và có thể kết nối với máy chủ thư IMAP nhưng cần trợ giúp về các tác vụ khác. Một điều nữa cần lưu ý là máy chủ IMAP của tôi yêu cầu xác thực SSL.

Ngoài ra tệp đính kèm có thể là tệp gz, tar hoặc tar.gz.

Answer 1

Một chương trình đơn giản làm những gì bạn muốn bên dưới.

#! /usr/bin/perl 

use warnings; 
use strict; 

Phiên bản tối thiểu cho Email::MIME là khi giới thiệu walk_parts.

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

Bạn không muốn mã hóa mật khẩu của mình trong chương trình, phải không?

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

Kết nối bằng SSL. Chúng ta phải có khả năng thực hiện điều này với tham số Ssl đơn giản đối với hàm tạo, nhưng một số nhà cung cấp đã chọn để phá vỡ nó trong các gói của họ.

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

Nếu bạn muốn một thư mục khác ngoài hộp thư đến, hãy thay đổi nó.

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

Sử dụng tìm kiếm IMAP, chúng tôi tìm tất cả các thư có chủ đề chứa ngày hôm nay theo định dạng YYYYMMDD. Ngày tháng có thể ở bất kỳ đâu trong chủ đề, ví dụ, một chủ đề của "foo bar baz 20100316" sẽ khớp với ngày hôm nay.

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

Đối với mỗi thư như vậy, hãy ghi phần đính kèm vào tệp trong thư mục hiện tại. Chúng tôi viết lớp ngoài cùng của tệp đính kèm và không đào cho các tệp đính kèm lồng nhau. Một phần có thông số tên trong loại nội dung của nó (như trong image/jpeg; name="foo.jpg") được giả định là tệp đính kèm và chúng tôi bỏ qua tất cả các phần khác. Tên của tệp đính kèm đã lưu là các thành phần sau được phân tách bằng -: ngày hôm nay, ID thư IMAP của nó, chỉ mục dựa trên một vị trí của nó trong thư và tên của nó.

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

Nếu bạn muốn gắn bó với Mail::IMAPClient, bạn có thể báo cho số điện thoại use SSL.

Hoặc, Net::IMAP::Simple::SSL cũng có thể giúp bạn. Giao diện giống với giao diện được cung cấp bởi Net::IMAP::Simple.

Khi bạn có thư, Parsing emails with attachments cho biết cách trích xuất tệp đính kèm. Tôi đã không thử nó, nhưng linh cảm của tôi là sử dụng Email::MIME::walk_parts có thể được sử dụng để đơn giản hóa đáng kể kịch bản được hiển thị trong bài viết PerlMonks.

Answer 3

Tôi đã thay đổi một chút cách tiếp cận để tải xuống tệp đính kèm từ @Greg, vì nó không được hiển thị không đáng tin cậy để tải xuống tệp đính kèm SAP XML. Họ không tuân theo tiêu chuẩn Content-Type: application/pdf; name=XXXXX vì vậy, nó đã cho tôi rất nhiều vấn đề.Ví dụ:

Content-ID: <payload-xxxxxxxxxxxxx@sap.com> 
Content-Disposition: attachment; 
    filename="XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml" 
Content-Type: application/xml 
Content-Descripton: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml 

Phần còn lại của chương trình vẫn gần như giống nhau. Sự khác biệt là bây giờ tôi đang sử dụng MIME::Parser để truy xuất tất cả thư và tôi vứt bỏ toàn bộ nội dung và hình ảnh có liên quan. Tôi cũng đã xóa Peek => 1 vì tôi muốn đánh dấu thư là đã đọc sau khi chúng được tải xuống (và chỉ điều hướng trên thư chưa đọc). Log::Logger giúp để tạo ra một log tập trung:

--- 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 khởi

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

--- Đoạn trích 3 --- Thư tải xuống

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