How to download IMAP email attachments over SSL and save them locally using Perl?

Question

I need suggestions on how to download attachments from my IMAP emails that have attachments and the current date in the subject line ie YYYYMMDD , and save the attachments in a local path.

I went through the Perl Mail :: IMAPClient module and can connect to the IMAP mail server, but you need help with other tasks. One more note: my IMAP server requires SSL authentication.

Attachments can also be gz, tar, or tar.gz files.

Answer 1

A simple program that does what you want is below.

 #! /usr/bin/perl use warnings; use strict; 

The minimum version for Email::MIME is when walk_parts was introduced.

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

You don’t want to hardcode your password in your program, right?

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

Connect using SSL. We should be able to do this with a simple Ssl parameter for the constructor, but some manufacturers decided to break it down in their packages.

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

If you need a folder other than the inbox, change it.

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

Using the IMAP search, we look for all messages whose topics contain today's date in the format YYYYMMDD. The date can be anywhere in the object, so, for example, the theme "foo bar baz 20100316" will correspond today.

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

For each such message, write file attachments in the current directory. We write an external attachment layer and do not dig nested attachments. The part with the name parameter in its content type (as in image/jpeg; name="foo.jpg" ) is considered an attachment, and we ignore all the other parts. The name of the saved attachment is the following components, separated by the - symbol: today's date, IMAP message identifier, one index of its position in the message and its 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

If you want to stick with Mail :: IMAPClient , you can tell it to use SSL .

Alternatively, Net :: IMAP :: Simple :: SSL can also help you with this. The interface is the same as Net :: IMAP :: Simple .

After receiving the message, Parsing emails with attachments shows how to extract attachments. I have not tried, but I suspect that using Email :: MIME :: walk_parts may be used to greatly simplify the script shown in this PerlMonks article.

Answer 3

I changed my approach to downloading attachments from @Greg a bit, as it was shown that loading SAP XML files is unreliable. They do not follow the Content-Type: application/pdf; name=XXXXX standard Content-Type: application/pdf; name=XXXXX Content-Type: application/pdf; name=XXXXX , so I had a lot of problems. Example:

 Content-ID: <[e-mail]> Content-Disposition: attachment; filename="XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml" Content-Type: application/xml Content-Descripton: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.xml 

The rest of the program remains almost the same. The difference is that I now use MIME::Parser to retrieve the entire message, and I throw away everything related to the body and image. I also deleted Peek => 1 , because I wanted to mark messages as read after they were downloaded (and only navigate through unread messages). Log::Logger helped create a centralized log:

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

--- Fragment 2 --- Initialization of the journal

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

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