Wie kann ich IMAP-Mail-Anhänge über SSL herunterladen und lokal mit Perl speichern?

Question

Ich brauche Vorschläge, wie ich Anhänge von meinen IMAP-Mails herunterladen kann, die Anhänge und das aktuelle Datum in der Betreffzeile haben, d. H. YYYYMMDD formatieren und die Anhänge auf einem lokalen Pfad speichern.

Ich ging durch das Perl-Modul Mail::IMAPClient und bin in der Lage, eine Verbindung mit dem IMAP-Mail-Server herzustellen, aber Hilfe bei anderen Aufgaben benötigen. Eine weitere Sache zu beachten ist, dass mein IMAP-Server SSL-Authentifizierung benötigt.

Auch die Anhänge könnten gz, tar oder tar.gz Dateien sein.

Answer 1

Ein einfaches Programm, das tut, was Sie wollen, ist unten.

#! /usr/bin/perl 

use warnings; 
use strict; 

Die Mindestversion für Email::MIME ist, wenn walk_parts eingeführt wurde.

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

Sie möchten Ihr Passwort nicht in Ihrem Programm fest codieren, oder?

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

Verbindung über SSL herstellen. Wir sollten in der Lage sein, dies mit einem einfachen Ssl Parameter für den Konstruktor zu tun, aber einige Anbieter haben entschieden, es in ihren Paketen zu brechen.

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

Wenn Sie einen anderen Ordner als den Posteingang möchten, ändern Sie ihn.

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

Mit IMAP suchen, suchen wir für alle Nachrichten, deren Themen das heutige Datum im Format JJJJMMTT enthalten. Das Datum kann irgendwo im Betreff sein, so würde beispielsweise ein Thema von "foo bar baz 20100316" heute übereinstimmen.

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

Schreiben Sie für jede solche Nachricht ihre Anlagen in Dateien im aktuellen Verzeichnis. Wir schreiben die äußerste Schicht von Anhängen und graben nicht nach verschachtelten Anhängen. Ein Teil mit einem Namensparameter in seinem Inhaltstyp (wie in image/jpeg; name="foo.jpg") wird als Anhang angenommen, und wir ignorieren alle anderen Teile. Der Name eines gespeicherten Anhangs besteht aus den folgenden Komponenten, die durch getrennt sind: Datum des heutigen Tages, seine IMAP-Nachrichten-ID, ein einzelner Index seiner Position in der Nachricht und sein Name.

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

Wenn Sie mit Mail::IMAPClient bleiben möchten, können Sie es an use SSL sagen.

Alternativ dazu könnte auch Net::IMAP::Simple::SSL Ihnen dabei helfen. Die Schnittstelle ist dieselbe wie die von Net::IMAP::Simple.

Sobald Sie die Nachricht haben, zeigt Parsing emails with attachments, wie Anhänge extrahiert werden. Ich habe es nicht ausprobiert, aber meine Vermutung ist, dass die Verwendung von Email::MIME::walk_parts verwendet werden kann, um das in diesem PerlMonks-Artikel gezeigte Skript wesentlich zu vereinfachen.

Answer 3

Ich habe meinen Ansatz zum Herunterladen von Anhängen von @Greg ein wenig geändert, da es unzuverlässig war, SAP-XML-Anhänge herunterzuladen. Sie folgen nicht dem Content-Type: application/pdf; name=XXXXX Standard, also gab es mir viele Probleme.Beispiel:

Der Rest des Programms bleibt fast gleich. Der Unterschied ist, dass ich jetzt MIME::Parser verwende, um alle Nachrichten abzurufen, und ich werfe alles weg, was mit dem Körper und dem Bild zusammenhängt. Ich entfernte auch die Peek => 1, da ich die Nachrichten als gelesen markieren wollte, nachdem sie heruntergeladen wurden (und nur in ungelesenen Nachrichten navigieren). Log::Logger half ein zentrales Protokoll erstellen soll:

--- 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 Initialisierung

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

--- Snippet 3 --- Mail-Downloader

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