Perl parse email and attachments from Outlook inbox - perl

I'm using Mail::IMAPClient to connect to our Outlook mail server. I can get the mail just fine and print the text version of that mail to a file. But I'm having trouble using MIME::Parser to parse through the email.
I've tried giving the parser a file handle to the text file that I wrote the email to. I've tried giving the parser just the text of the email but it won't work how I'm expecting it to work. The entity parts always equals 0.
When I dump the entity skeleton I get
Content-type: text/plain
Effective-type: text/plain
Body-file: NONE
--
I can see all of the parts of the email in the file. The two PDFs that are attached are there, encoded in base64, so I know that the script is actually retrieving the email and the attachments. I've also tried parse and parse_data.
my $msgCount = 0;
$msgCount = $imap->message_count();
#or abortMission("", "Could not get message count: ". $imap->LastError );
if ( $msgCount > 0 ) {
#get all the messages from the inbox folder
my #msgseqnos = $imap->messages
or abortMission("", "Could not retreive messages:". $imap->LastError);
my ($x, $bh, $attachment, $attachmentName);
foreach my $seqno ( #msgseqnos ) {
my $input_file;
my $parser = new MIME::Parser;
my $emailText = $imap->body_string($seqno) # should be the entire email as text.
or abortMission("", "Could not get message string: " . $imap->LastError);
$parser->ignore_errors(1);
$parser->output_to_core(1);
open my $emailFileHandle, ">", "invoiceText.txt";
print $emailFileHandle $emailText;
#$imap->message_to_file($emailFileHandle, $seqno);
my $entity = $parser->parse_data($emailText);
$entity->dump_skeleton;
if ( $entity->parts > 0 ) {
for ( my $i = 0; $i < $entity->parts; $i++ ) {
my $subentity = $entity->parts($i);
# grab attachment name and contents
foreach $x ( #attypes ) {
if ( $subentity->mime_type =~ m/$x/i ) {
$bh = $subentity->bodyhandle;
$attachment = $bh->as_string;
$attachmentName = $subentity->head->mime_attr('content-disposition.filename');
open FH, ">$attachmentName";
print FH $attachment;
close FH;
#push #attachment, $attachment;
#push #attname, $subentity->head->mime_attr('content-disposition.filename');
}
}
}
}
else {
stillAGo("eData VehicleInvoices problem", "Perl can't find an attachment in an email in the VehicleInvoices folder of eData email address");
}
close $emailFileHandle;
# say $emailText;
# next;
#open OUT_FILE, ">invoiceText.txt";
#print OUT_FILE $emailText;
#print OUT_FILE $imap->bodypart_string($seqno,1);
#close OUT_FILE;
#print $emailText;
}
}
I'm trying to retrieve the attachments from emails automatically and save them to disk to be processed by another job.
I'd like to include the invoiceText.txt file so people can see the actual output but it's 1200 lines long. I'm not sure where to upload a file to link in here.

The body_string method doesn't return the entire email. As the documentation describes, and the name implies, it returns the body of the message, excluding the headers. That is why dump_skeleton shows no headers apart from the defaults
What you probably want, although I haven't tried it, is message_string, which does return the entire email
I see you've used message_to_file but commented it out. That would probably have worked if you got MIME::Parse to read from the file

Related

Generate Mail and Open it in Outlook using Perl

Does anyone know as how can I make a mail in perl using outlook and not send it just open it on the screen at the end of making the mail and let the user verify and send the mail. I am using Win32::OLE for making the mail.
PFB the code I am using:
sub Final_Mail_Outlook{
my($mailTo,$mailFrom,$subject,$body) = (#_);
my $Outlook = Win32::OLE->GetActiveObject('Outlook.Application') || Win32::OLE->new('Outlook.Application');
# Create Mail Item
my $item = $Outlook->CreateItem(0); # 0 = mail item.
unless ($item)
{
die "Outlook is not running, cannot send mail.\n";
}
$item->{'Subject'} = $subject;
$item->{'To'} = $mailTo;
$item->{'Body'} = $body;
$item->{'From'} = $mailFrom;
my $attach = $item->{'Attachments'};
my #outputFiles = glob("$OutputPath\\*.*");
foreach my $file (#outputFiles){
$attach->add($file);
}
$item->Send();
}
This sends the mail as I have called Send function, but I want to verify the mail generated. So is there a way to do so???
I just found an answer to it so thought of posting it also so that someone else needing an answer to this can get help. The key is to use the function Display() instead of Send(). PFB the modified code to open the mail and not send it.
sub Final_Mail_Outlook{
my($mailTo,$mailFrom,$subject,$body) = (#_);
my $Outlook = Win32::OLE->GetActiveObject('Outlook.Application') || Win32::OLE->new('Outlook.Application');
# Create Mail Item
my $item = $Outlook->CreateItem(0); # 0 = mail item.
unless ($item)
{
die "Outlook is not running, cannot send mail.\n";
}
$item->{'Subject'} = $subject;
$item->{'To'} = $mailTo;
$item->{'Body'} = $body;
$item->{'From'} = $mailFrom;
my $attach = $item->{'Attachments'};
my #outputFiles = glob("$OutputPath\\*.*");
foreach my $file (#outputFiles){
$attach->add($file);
}
$item->Display();
}

Downloading attachment from Exchange message with Perl

I am automatically downloading mails from an Exchange 2010 server via perl. So far I have managed to access the message via Exchange Web Services (EWS) and parse headers. Now I wonder how I can download the attachments of a message to a local temporary folder.
I am new to Perl language and cannot find the source code or documentation for the message data structure. Any help is appreciated.
use Email::Folder::Exchange;
use Email::Simple;
# some more code here....
my $folder = Email::Folder::Exchange->new($url, $user, $pass);
for my $message ($folder->messages) {
if ($message->header('Subject') =~ /Downloadable Message/) {
// How to access message's attachments?
}
}
So basically the trick is to convert the Email::Simple to Email::MIME and use Email::MIME::Attachment::Stripper to parse through each attachment. Easy ;-)
! I only copied the relevant parts... so you might need to extend it a little for reuse.
use Email::Folder::Exchange;
use Email::Simple;
use Email::MIME::Attachment::Stripper;
# some more code here....
my $folder = Email::Folder::Exchange->new($url, $user, $pass);
for my $message ($folder->messages) {
my $tmpMsg = Email::MIME->new($message->as_string);
my $stripper = Email::MIME::Attachment::Stripper->new($tmpMsg);
for my $a ($stripper->attachments()) {
next if $a->{'filename'} !~ /csv/i; #only csv attachments
my $tempdir = "C:\\temp\\";
my $tmpPath = $tmpdir . $a->{'filename'};
# Save file to temporary path
my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
print $f $a->{'payload'};
}
}

Email::MIME can't parse message from Gmail

So I'm using PERL and Email::MIME to get an email from gmail. Here is my code:
use Net::IMAP::Simple::Gmail;
use Email::Mime;
# Creat the object that will read the emails
$server = 'imap.gmail.com';
$imap = Net::IMAP::Simple::Gmail->new($server);
# User and password
$user = 'username#gmail.com';
$password = 'passowrd';
$imap->login($user => $password);
# Select the INBOX and returns the number of messages
$numberOfMessages = $imap->select('INBOX');
# Now let's go through the messages from the top
for ($i = 1; $i <= $numberOfMessages; $i++)
{
$top = $imap->top($i);
print "top = $top\n";
$email = Email::MIME->new( join '', #{ $imap->top($i) } );
$body = $email->body_str;
print "Body = $body\n";
}#end for i
When I run it, I get the following error:
can't get body as a string for multipart/related; boundary="----=_Part_6796768_17893472.1369009276778"; type="text/html" at /Library/Perl/5.8.8/Email/Mime.pm line 341
Email::MIME::body_str('Email::MIME=HASH(0x87afb4)') called at readPhoneEmailFeed.pl line 37
If I replace
$body = $email->body_str;
with
$body = $email->body;
I get the output:
Body =
(i.e. empty string)
What's going on here? is there a way for me to get the raw body of the message (->body_raw doesn't work either)? I'm okay with parsing out the body using regex
Email::MIME is not the best documented package I have ever seen.
The body and body_str methods only work on a single mime part. Mostly that would be a simple text message. For anything more complex use the parts method to get each mime component which is itself an Email::MIME object. The body and body_str methods should work on that. An html formatted message will generally have two MIME parts: text/plain and text/html.
This isn't exactly what you want but should be enough to show you what is going on.
my #parts = $email->parts;
for my $part (#parts) {
print "type: ", $part->content_type, "\n";
print "body: ", $part->body, "\n";
}

Perl to parse email, change "From:" header, send onwards

I wish I was lying, but I've spent several months trying to get this to work and I have to admit defeat on my perl scripting skills. I'm at a loss to make this work and need help (for which I wil be very grateful).
The background:
I am running a discussion email list using a third party Listserv. I want to change the "From" header on incoming emails to an address at my domain, by doing a database lookup for the email address, and then adding the users name and company code to the From header, and sending it on.
For example, Super Dave , is changed to David Smith (ABC - LON) , and then the list members will see that header instead of whatever he has chosen as his "From free text".
The script I have developed works very well ... except that more complex emails seem to stun it. Right now the script takes a text version of the email, strips out all the MIME parts and html bits, and changes the header. If it encounters an email format thats new to it (and I havent written a code line to handle), it stops. I could continue fixing each type of email coming in, but I think thats overkill - I need to get back to the KISS method.
Note: the database lookup is without issue. The problem is in the way the email body finally arrives at the listserver.
Instead of this, I want to leave the original email untouched, but just change the From header. Nothing else. Is there any way to do that? Here is (the salient part of) the script.
What Im after is a much simpler method to search the email for the from Header, change it to another value, and then send it on.
Thoughts?
$connect = DBI->connect($dsn, $user, $pw);
open FH, ">mail.txt" or die "can't open mail.txt: $!";
while ( $_ = <STDIN>) {
print FH "$_";
}
close(FH);
$file_content = `cat 'mail.txt' | grep -m1 From |tail -n+1`;
chomp($file_content);
$from = `echo "$file_content"| sed -e "s/.*<//;s/>.*//"`;
chomp($from);
$subject=`cat mail.txt |grep -m1 Subject| sed -e "s/.*Subject: //"`;
chomp($subject);
system('./body.sh');
$encoded=`cat body.txt`;
#Decode the mail and save output to dbody.txt. Still have header+body at this stage.
$body=decode_qp($encoded);
open FF, ">dbody.txt" or die $!;
print FF $body;
close FF;
#If body still has headers, Look for first blank line, and delete all before - this is the body
$bodycheck =`cat dbody.txt`;
if ($bodycheck =~ /Message-Id/ ){
$bodyfinal= `sed '0,/^\$/d' dbody.txt`;
} else {
$bodyfinal =$bodycheck
}
#Save the output to bodyfinal.txt
open FF, ">bodyfinal.txt" or die $!;
print FF $bodyfinal;
close FF;
#THIS SECTION contains code to query the database with the original FROM email address
#get username and domain and then change to lower case for the query
$case_username = substr($from, 0, index($from, '#'));
$m_username = lc($case_username);
$case_domain = substr($from, index($from, '#')+1);
$m_domain = lc($case_domain);
#print "\n##############$m_username\#$m_domain#################\n";
$query = "select user_real_name, company_code, location_code from user where user_email='$m_username\#$m_domain'";
$query_handle = $connect->prepare($query);
$query_handle->execute() or die $DBI::errstr;
#result=$query_handle->fetchrow_array();
print "\n#result\n";
##Forward the mail
sub sendEmail
{
my ($to, $from_sub, $subject, $message) = #_;
my $sendmail = '/usr/sbin/sendmail';
open(MAIL, "|$sendmail -oi -t");
print MAIL "From: $from_sub\n";
print MAIL "To: $to\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message\n";
close(MAIL);
}
{my $msg = MIME::Lite->new
(
Subject => "$subject",
From => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail#>",
To => 'opg#maillist.com',
Type => 'text/plain',
Encoding => '7bit',
Data => "From: $result[0]/$result[1]-$codes[0]/$result[2] \n________________________________________________ \n \n$bodyfinal \n"
);
$msg->send();
}
To only answer "what is a simple method to search some file for a From: header,
change it to another value, and send it on?": use Tie::File;
Given a file named 'email' that contains the example headers from this page,
#! /usr/bin/env perl
use common::sense;
use Tie::File;
tie my #f, 'Tie::File', 'email' or die $!;
for (#f) {
if (/^From:/) {
say "old: $_";
s/(?<=^From:).*$/ A New Sender <anewsender\#ans.com>/;
say "new: $_";
last
}
}
untie #f;
Output:
$ perl tie-ex
old: From: Taylor Evans <example_from#dc.edu>
new: From: A New Sender <anewsender#ans.com>
$ grep ^From email
From: A New Sender <anewsender#ans.com>
Mind, there's all kinds of wrong with this. Headers don't need to be neatly on one line; there can be more than one From: header (by someone else's scripting error, for instance); there can even be no From: header in the headers and then a From: randomly in the body. Spammers do strange things. But if your original code already contains these limitations and you're happy enough with them, try this.
Meanwhile, there are already great Perl modules that handle mail. Take a look through the Email:: modules listed here.

Perl ftp question, like the previous ones

I need to move or copy a simple text file from one web site to another web site.
I have administrator rights to both web sites. The first web site has a large data file (again, just a text file), certain records are selected and written to a team file (for entry into a tournament). Next I go through paypal and pay for the entries. The second site is for the the club running the tournament and I use IPN to return to a script on their site and if it verified, I add the team memebers into the master file for the tournament. I am limited to the ONE IPN script on the tournament site because I have a ton of other entries that come in from all over. The first site has the rosters for the state and no need to type all that data from each club, use the rosters like I use for all the non-paypal tounamenmts.
I can ftp the team file to the second server and place it in the folder just like it was created from scratch from that server originally and everything should go fine but I took the examples and tried them and nothing.
Here's the code section:
my $custom = $in->param('custom');
my $filename = "$ENV{DOCUMENT_ROOT}/database/$custom";
my $usjochost = '208.109.14.105';
my $okserieshost = '208.109.181.196';
my $usjocuser = 'teamentry';
my $okseriesuser = 'okwaentry';
my $usjocpw = 'Password1';
my $okseriespw = 'Password1';
my $file = $custom;
my $usjocpath ='/home/content/u/s/j/usjoc/html/database/';
my $okseriespath ='/home/content/o/k/s/okseries/html/database/';
$ftp = Net::FTP->new($okserieshost, Debug => 0) or die "Could not connect to '$okserieshost': $#";
$ftp->login($okseriesuser, $okseriespw) or die sprintf "Could not login: %s", $ftp->message;
#$ftp->cwd(/database) or die sprintf "Could not login: %s", $ftp->message;
$ftp->get($filename);
#$ftp = Net::FTP->new($usjochost, Debug => 0) or die "Could not connect to '$usjochost': $#";
$ftp->quit;
I NEED to READ the file on the first web site (okseries.com) and write the file on the second web site (usjoc.com). I have no problem reading and writing the file on the server, is sending the file to the second server. HELP! I'm not a genius at PERL.
i tested the code you made and implemented to it, the follow code will connect to your first host, okserieshost and get the $filename from database folder, verify if the file was downloaded (if not it will end operations).
#!/usr/bin/perl
use Net::FTP;
my $path = '/public_html/api';
my $filename = 'index.php';
my $host = '';
my $user = '';
my $pass = '';
print "Content-type: text/html\n\n";
$ftp = Net::FTP->new($host, Debug => 0) or die "Could not connect to $host: $#";
print "<pre>".$ftp->message ."</pre><br>\n";
$ftp->login($user,$pass) or die sprintf "Could not login: %s", $ftp->message;
print "<pre>".$ftp->message ."</pre><br>\n";
my $cur = $ftp->pwd();
my $new = $ftp->cwd($path);
if ($cur == $new) {
$ftp->quit;
print "Directory not found, exiting.\n";
} else {
if ($ftp->size($path.'/'.$filename) >= 0) {
$ftp->get($path.'/'.$filename) or die $ftp->message;
print "<pre>".$ftp->message ."</pre><br>\n";
print "File downloaded with success." if (-e $filename);
} else {
print "File not found.\n";
}
}
$ftp->quit;
i've changed the code a little you can put this file on usjoc.com and run it on the browser it wil display every step of the communication until it gets the file from okseries.com.
All you have to do is change $path to the path of where the file is but do not end the directory name with a /
filename in case on $filename
$host = ftp ip or hostname
$uesr and $pass i guess you know what goes in
response from the url you asked to be viewed:
USJOC Entry Form on
The Club file name is EdmondSkunks1T.db
/home/content/o/k/s/okseries/html/database/EdmondSkunks1T.db
Supposedly opened /home/content/o/k/s/okseries/html/database/EdmondSkunks1T.db
Back to USJOC