Come posso scaricare gli allegati di posta IMAP su SSL e salvarli localmente usando Perl?

Question

Ho bisogno di suggerimenti su come posso scaricare gli allegati dalle mie mail IMAP che hanno allegati e data corrente in oggetto, ad esempio il formato YYYYMMDD e salvare gli allegati su un percorso locale.

Sono passato attraverso il modulo Perl Mail::IMAPClient e sono in grado di connettersi al server di posta IMAP, ma ho bisogno di aiuto su altre attività. Un'altra cosa da notare è che il mio server IMAP richiede l'autenticazione SSL.

Anche gli allegati possono essere file gz, tar o tar.gz.

Answer 1

Un semplice programma che fa quello che vuoi è sotto.

#! /usr/bin/perl 

use warnings; 
use strict; 

La versione minima per Email::MIME è per quando walk_parts è stato introdotto.

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

Non si desidera inserire la password nel programma, vero?

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

Connessione tramite SSL. Dovremmo essere in grado di farlo con un semplice parametro Ssl per il costruttore, ma alcuni venditori hanno scelto di romperlo nei loro pacchetti.

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

Se si desidera una cartella diversa dalla Posta in arrivo, modificarla.

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

Utilizzando ricerca IMAP, cerchiamo tutti i messaggi i cui soggetti contenere la data odierna in formato AAAAMMGG. La data può essere ovunque nell'oggetto, quindi, ad esempio, un soggetto di "foo bar baz 20100316" corrisponderebbe a oggi.

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

Per ogni messaggio di questo tipo, scrivere gli allegati ai file nella directory corrente. Scriviamo il livello più esterno degli allegati e non scaviamo per gli allegati annidati. Si presume che una parte con un parametro name nel suo tipo di contenuto (come in image/jpeg; name="foo.jpg") sia un allegato e ignoriamo tutte le altre parti. Il nome di un allegato salvato è i seguenti componenti separati da -: la data odierna, il suo ID messaggio IMAP, un indice a un punto della sua posizione nel messaggio e il suo nome.

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

Se si desidera attenersi a Mail::IMAPClient, è possibile dirlo a use SSL.

In alternativa, Net::IMAP::Simple::SSL potrebbe anche aiutare con quello. L'interfaccia è la stessa di quella fornita da Net::IMAP::Simple.

Una volta ricevuto il messaggio, Parsing emails with attachments mostra come estrarre gli allegati. Non l'ho provato, ma la mia impressione è che l'uso di Email::MIME::walk_parts può essere usato per semplificare notevolmente lo script mostrato in quell'articolo di PerlMonks.

Answer 3

Ho modificato leggermente il mio approccio per scaricare gli allegati da @Greg, poiché è stato dimostrato che non è in grado di scaricare gli allegati SAP XML. Non seguono lo standard Content-Type: application/pdf; name=XXXXX quindi mi hanno dato molti problemi.Esempio:

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

Il resto del programma rimane quasi lo stesso. La differenza è che ora sto usando MIME::Parser per recuperare tutto il messaggio, e butto via tutto ciò che è relativo al corpo e all'immagine. Ho anche rimosso lo Peek => 1 poiché volevo contrassegnare i messaggi come letti dopo che sono stati scaricati (e navigare solo sui messaggi non letti). Log::Logger contribuito a creare un registro centralizzato:

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

$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 --- Downloader per posta elettronica

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