I have a legacy app that needs to change. it is written in perl and uses send::mail to send mails to users. Previously we sent links in the email message body but now they want pdf attachments instead. The PDF's are generated on another server using php.
the workflow would be
create the email body
get the pdf from another server via a URL
add the pdf as an attachment to the email
send it.
I think I can use
use LWP::Simple;
unless (defined ($content = get $URL)) {
die "could not get $URL\n";
}
to get the contents of the URL but I can't figure out how to use that var as an attachment in sendmail. current sendmail code is:
my %maildata = (To => $to,
From => 'OurSite - Billing <billing#ourSite.com>',
Organization => 'OurSite, LLC http://www.OurSite.com/',
Bcc => 'sent-billing#ourSite.com',
Subject => $subject{$message} || 'ourSite invoice',
Message => $body
);
print STDERR "notify1 now calling sendmail\n";
sendmail(%maildata) || print STDERR $Mail::Sendmail::error;
The other issue I have is I don't know how to find out if the version of sendmail I have (old freebsd system) is even capable of sending attachments ?
ok thanks for the posters who gave me some direction / the will to give it a go.
In the end I built the mime body doing the following
use LWP::Simple;
use MIME::Base64;
unless (defined ($content = get $URL)) {
die "could not get $URL\n";
}
my $pdfencoded = encode_base64($content);
my %maildata = (To => $to,
From => 'OurSite - Billing <billing#ourSite.com>',
Organization => 'OurSite, LLC http://www.OurSite.com/',
Bcc => 'sent-billing#ourSite.com',
Subject => $subject{$message} || 'ourSite invoice',
);
my $boundary = "====" . time() . "====";
$maildata{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
$maildata{'Message'} = "--".$boundary."\n"."Content-Type: text/plain\n".$body.
"\n--".$boundary."\nContent-Transfer-Encoding: base64\nContent-Type:
application/pdf; name=\"invoice.pdf\"\n".$pdfencoded."\n--".$boundary."--";
sendmail(%maildata) || print STDERR $Mail::Sendmail::error;
This gave me a hand built MIME format for the body content.
Thanks for the help !
Related
The following Perl program gives an access denied error at line 44 when I try to print either the entire string or the encoded portion. If I print just the header using $msg->print_header(\*STDOUT).
What I am trying to do is generate a text file that contains all the information that could be used in a telnet command to test a Message Transfer Agent (MTA) by sending an email with an attachment.
use MIME::Lite;
use Net::SMTP;
### Add the sender, recipient and your SMTP mailhost
my $from_address = 'temp999 at gmail.com';
my $to_address = 'test05#gmail.com';
my $mail_host = 'gmail.com';
### Adjust subject and body message
my $subject = 'Testing script';
my $message_body = "I am sending an email with an attachment";
### Adjust the filenames
my $my_file_xlsx = 'c:/temp';
my $your_file_xlsx = 'count.xlsx';
### Create the multipart container
$msg = MIME::Lite->new(
From => $from_address,
To => $to_address,
Subject => $subject,
Type => 'multipart/mixed'
) or die "Error creating multipart container: $!\n";
### Add the text for the message body
$msg->attach(
Type => 'TEXT',
Data => $message_body
) or die "Error adding the text message part: $!\n";
### Adding an Excel file
$msg->attach(
Type => 'application/octet-stream',
Path => $my_file_xlsx,
Filename => $your_file_xlsx,
Disposition => 'attachment'
) or die "Error adding $file_xls: $!\n";
### Send the Message
MIME::Lite->send('smtp', $mail_host, Timeout => 60);
#$msg->send;
$msg->print(\*STDOUT); # Write to a file handle ### LINE 44 ###
#$msg->print_header(\*STDOUT); # Write the header
#$msg->print_body(\*STDOUT); # Write the encoded body
I haven't found anything matching exactly what I am trying to do, but I might not be using the correct terminology when searching.
You're trying to attach the file c:/temp, which is (presumably) a directory, not a file. When MIME::Lite tries to open it as a file to read the contents,it fails with that error. You probably meant to pass c:/temp/count.xlsx as Path.
• I am working to migrate a Linux server to a newer one from Ubuntu 10.04 to 12.04
• This server is responsible for executing several a number of Perl modules via crontabs.
• These Perl Modules rely heavily on 30-40 perl extensions.
• I have installed all Perl extensions and the crontabs are able to process successfully except for several Syntax errors caused by the newer versions of these PERL extensions.
• I need some help with modifying the syntax to get the Perl script to process as intended.
This is my error message:
2015/12/28 12:56:48 ./cms.pl 88 FATAL main - Can't call method "verify" on an undefined value at pm/Emails/Core.pm line 438.
Code:
#===================================================================================================
# Send an eamil
# Args: enable_clients?, BCC Arrayref [admin1#a.com, ...], Hashref { email_address, email_subject, email_body }
#===================================================================================================
sub pm::Emails::Core::send_email {
my ($self, $enable_clients, $bcc, $email) = #_;
# die('Invalid BCC array') unless $bcc;
die('Invalid Email hashref') unless ($email && $email->{email_address} && $email->{email_subject} && $email->{email_body});
$email->{email_address} = trim $email->{email_address}; # Trim the email address just to be sure no invalid emails sneak in
my $mime = undef;
my $smtp = undef;
###
# Get a handle to the logger
my $logger = Log::Log4perl->get_logger();
die('Failed to create logger') unless $logger;
###
###
# Send the email using the local SMTP server
# SPAM FILTER NOTES:
# We are sending the email as inlined HTML.
# Sending the email as a multipart with HTML & PlainText is getting flagged as SPAM.
{
my $msg = join(', ',
(
'Time:' . localtime(),
'Sending Email TO: ' . $email->{email_address},
#'BCC: ' . join(',', #$bcc),
'SUBJECT: ' . $email->{email_subject},
'Clients Enabled: ' . ($enable_clients ? 'true' : 'false')
)
);
$logger->warn($msg);
open(FILE, '>>/var/log/mail.log') or die('Failed to open mail log: /var/log/mail.log');
print FILE $msg . "\n";
close FILE;
}
###
if (!defined($self->{_phpversion_})) {
$self->{_phpversion_} = `php -r 'print phpversion();' 2>/dev/null`;
}
###
# Generate the MIME email message
$mime = MIME::Lite->new(
Subject => $email->{email_subject},
To => $email->{email_address},
Type => 'text/html',
Data => $email->{email_body},
'Reply-To' => 'test#test.com',
'Return-Path' => 'test#test.com',
From => 'test#test.com',
Organization => 'Testing',
'X-Mailer' => 'PHP' . $self->{_phpversion_}
);
###
# Check to see if we are sending the email to clients, if not then redirect to another account & update the subject
if ($enable_clients) {
$logger->warn('Sending email to clients is enabled!');
} else {
use Sys::Hostname;
$logger->warn('Sending email to clients is disabled!');
$email->{email_address} = 'test#test.com';
$email->{email_subject} = '<' . hostname . ' - ADMIN ONLY EMAIL> ' . $email->{email_subject};
$mime->replace(Subject => $email->{email_subject});
}
$mime->preamble('');
$mime->top_level(1);
$mime = $mime->as_string();
###
###
# Connect to the SMTP server & send the message
$logger->debug('Connecting to SMPT server');
$smtp = Net::SMTP->new('localhost', Timeout => 60, Debug => 0, Hello => 'test.com');
$logger->debug('Connected to SMPT server');
###
###
# Verify we can send the email to the included addresses
foreach my $email_address (($email->{email_address}), #$bcc) {
$logger->debug('Verifying Email address: ' . $email_address);
next if $smtp->verify($email_address);
$logger->warn('Failed to verify email address: ' . $email_address . ', re-connecting to SMPT');
$smtp = Net::SMTP->new('localhost', Timeout => 60, Debug => 1, Hello => 'test.com');
die('Failed to reconnect to SMPT server') unless $smtp;
last;
}
###
###
# Send the email message
$smtp->mail('test#test.com');
$smtp->bcc(#$bcc, { Notify => ['FAILURE','DELAY', 'SUCCESS'] });
$smtp->to($email->{email_address}, { Notify => ['FAILURE','DELAY', 'SUCCESS'] });
$smtp->data; # This will start the data connection for the message body
$smtp->datasend( $mime ); # This will send the data for the message body
$smtp->dataend; # This will end the message body and send the message to the user
$smtp->quit;
###
use List::Util qw[min];
sleep(min(1, int(rand(2))));
}
Any help on this is greatly appreciated.
You don't create the $smtp object (using $smtp = Net::SMTP->new(...)) until three lines after you try to call the verify() method on it. So of course it's going to be undefined at that point.
The only way that this could ever work is if the $smtp is also created earlier on in code that you haven't shown us. But assuming that you have shown us all mentions of $smtp, then this code can't possibly have worked on the old server only. This is not a problem that is caused by a newer version of Perl, it's a logic error that would never have worked.
The obvious way to fix this is to re-order the code so that the object is created before you try to use it. But as I can only see a small amount of the code, I have no way of knowing whether this would have knock-on effects elsewhere.
Have you considered paying a Perl programmer to help you carry out these migrations? Expecting free consultancy from StackOverflow isn't really a sustainable business model :-/
Update: Ok, so now you've added more code, we can see that the $smtp is initialised a few lines before the call to verify. So why are you getting the error?
If you read the documentation for Net::SMTP, in the section describing the new() method, it says:
On failure undef will be returned and $# will contain the reason for
the failure.
It looks like this is what is happening. But your code isn't checking the return code from the new() and is assuming that it will always work - which is a pretty strange assumption to make. To fine out what is going wrong, you'll need to add some debugging output to the two lines that create your SMTP object. Where you have:
$smtp = Net::SMTP->new(...);
Change it to:
$smtp = Net::SMTP->new(...)
or die $#;
That way, if you fail to connect to the SMTP server, your program will die with a (hopefully) useful error message which will enable you to investigate further.
Incidentally, I don't know where your code comes from, but no-one really recommends Net::SMTP these days. It's all rather low-level. You would be better off looking at Email::Sender or Email::Stuffer (that's the kind of useful knowledge that a Perl programmer would bring to this project..
Hey Guys just Wanted to follow up on this problem. I tried all of your suggestions and was unable to get a solution.
However more in-depth research of the SMTP/Mail running on this machine revealed that it was running Postfix, it turns out this script was written for SendMail. Simply did the following:
Uninstall Postfix-
sudo apt-get purge postfix
Install Sendmail-
sudo apt-get install sendmail
All was resolved, thank you guys for all your help.
i am trying to send a mail through Perl script using net::smtp module.It works fine when i send the normal mail without any attachment.i wont receive any mail.
use Net::SMTP;
use MIME::Base64;
use File::Basename;
use MIME::Base64 qw( encode_base64 );
use MIME::Base64 qw( decode_base64 );
#attachments = 'C:\Users\ups7kor\Desktop\scripts\commadnline\appending.pl';
$toAddress = '***';
$fromAddress = '***';
$ServerName = '***';
my $boundary = 'End Of mail';
my $smtp = Net::SMTP->new($ServerName, Timeout => 60) or print $failureLogHandler ++$errrorCount.")ERROR:Could not create SMTP object . \n\t please check SMPT Adress in $iniFileData{INI_SMTP_SERVER_NAME} of $iniFileSection{INI_EMAIL} section ";
$smtp->mail($fromAddress);
$smtp->recipient($toAddress, { SkipBad => 1 });
$smtp->data();
$smtp->datasend("To: $toAddress\n");
$smtp->datasend("From: $fromAddress\n");
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("MIME-Version: 1.0\n");
$smtp->datasend("Content-type: multipart/mixed;\n\tboundary=\"$boundary\"\n");
$smtp->datasend("--$boundary\n");
$smtp->datasend("Content-type: text/plain\n");
$smtp->datasend("Content-Disposition: quoted-printable\n");
$smtp->datasend("\n $messageBody\n");
if(#attachments)
{
$smtp->datasend("--$boundary\n");
foreach $attachment (#attachments)
{
open(DAT, $attachment) || die("Could not open text file!");
my #textFile = <DAT>;
close(DAT);
my $filename = basename($attachment);
$smtp->datasend("Content-Type: application/text; name=\"$filename\"\n");
$smtp->datasend("Content-Disposition: attachment; filename=\"$filename\"\n");
$smtp->datasend("\n");
$smtp->datasend("#textFile\n");
}
}
$smtp->datasend("--$boundary --\n");
$smtp->dataend();
$smtp->quit;
But if i try the same code in other machine it works file.
Why the same code is not working in my machine and working fine in other machine.
Please help out.
You're using some rather low-level tools for building your message. That would probably work, but you'd need to implement all of the rules for building MIME messages - which sounds far too much like hard work.
Whenever I want to do something with email and Perl, I look for the appropriate module in the Email::* namespace. I'd probably start with Email::MIME, but I note that now includes a pointer to Email::Stuffer, which might well be even simpler.
You could use MIME::Lite module.
See: https://metacpan.org/pod/MIME::Lite#Create-a-multipart-message
Synopsis:
### Create the multipart "container":
$msg = MIME::Lite->new(
From =>'me#myhost.com',
To =>'you#yourhost.com',
Cc =>'some#other.com, some#more.com',
Subject =>'A message with 2 parts...',
Type =>'multipart/mixed'
);
### Add the text message part:
### (Note that "attach" has same arguments as "new"):
$msg->attach(
Type =>'TEXT',
Data =>"Here's the GIF file you wanted"
);
### Add the image part:
$msg->attach(
Type =>'image/gif',
Path =>'aaa000123.gif',
Filename =>'logo.gif',
Disposition => 'attachment'
);
Update: As per Dave's comment:
Check out Email::Stuffer module. Creating multipart message with it is really simple.
Email::Stuffer->to('Simon Cozens<simon#somewhere.jp>')
->from('Santa#northpole.org')
->text_body("You've been good this year. No coal for you.")
->attach_file('choochoo.gif')
->send;
You can use Mail::Sender module to send mails with attachment with body included. Just a small example of how to implement if you have this module in place.
my $sender = new Mail::Sender {smtp => 'server name', from =>
'emailId'};
$sender->MailFile( {to => 'xxx.gmail.com,yyy.gmail.com', subject => 'some subject that you want to put',
msg => "Body of the mail", file => 'path for the attachment that you need to send'} );
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.
I am trying to write a Perl script to connect to me YouTube account but it doesnt seem to work. Basically I just want to connect to my account but apparently it is not working. I don't even have an idea on how I could debug this! Maybe it is something related to https protocol?
Please enlighten me! Thanks in advance.
use HTTP::Request::Common;
use LWP::UserAgent;
use strict;
my $login="test";
my $pass = "test";
my $res = "";
my $ua = "";
# Create user agent, make it look like FireFox and store cookies
$ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.12) Gecko/20051213 Firefox/1.0.7");
$ua->cookie_jar ( {} );
# Request login page
$res = $ua->request(GET "https://www.google.com/accounts/ServiceLogin?service=youtube&hl=en_US&passive=true<mpl=sso&uilel=3&continue=http%3A//www.youtube.com/signup%3Fhl%3Den_US%26warned%3D%26nomobiletemp%3D1%26next%3D/index");
die("ERROR1: GET http://www.youtube.com/login\n") unless ($res->is_success);
# Now we login with our user/pass
$res = $ua->request(
POST "https://www.google.com/accounts/ServiceLoginAuth?service=youtube",
Referer => "http://www.youtube.com/login",
Content_Type => "application/x-www-form-urlencoded",
Content => [
currentform => "login",
next => "/index",
username => $login,
password => $pass,
action_login => "Log+In"
]
);
# YouTube redirects (302) to a new page when login is success
# and returns OK (200) if the login failed.
#die("ERROR: Login Failed\n") unless ($res->is_redirect());
print $res->content;
what i am doing is learning the web features of perl, so i dont want to use any library except wwwlib or mechanize to get the job done.
how can i just connect to my account using a perl script? this is my objective for now
hope someone can post a script or correct mine.
thank you guys for you help.
i am testing Webscarab now..
What data are you trying to grab? Why not just using an existing implementation like WebService::YouTube
Some comments on your code: I always avoided the shortcut $ua->request(GET/POST) method since I always ended up needing more flexibility that only the use of HTTP::Request and HTTP::Response allowed. I always felt the code was cleaner that way too.
Why is your code not working? Who knows.
Make sure your cookiejar is adding your cookies to the outgoing HTTP::Request. I'd suggest dumping all your headers when you do it in a browser and compare with the headers and data that libwww is sending. There may be some additional fields that they are checking for that vary for every hit. They may be checking for your UserAgent string. If you are just looking to learn libwww I'd suggest using a different site as a target as I'm sure YouTube has all sort of anti-scripting hardening.
Are you using YouTube's stable documented API?
Use an HTTP proxy such as WebScarab to watch the data flow.
Trey's suggestion to use somebody else's CPAN package for the mechanics is a good idea too.
Right right by and large, what you want to do is define a cookiejar for most of these websites that have a redirection login. This is what the package has done. Also the package tunes a lot of the lookups and scrapes based on the youtube spec.
Ajax content for example will be rough since its not there when your scraping
You just picked a somewhat rough page to start out with.
Enjoy
I'm actually working on this issue myself. Before, I would suggest read over this the API guide from Google as a good starting reference. If I'm reading it correctly, one begins with passing user credentials through a REST interface to get a Authentication Token. To handle that, I'm using the following:
sub getToken {
my %parms = #_;
my $response = LWP::UserAgent->new->post(
'https://www.google.com/youtube/accounts/ClientLogin',
[
Email => $parms{'username'},
Passwd => $parms{'password'},
service => "youtube",
source => "<<Your Value Here>>",
]
);
my $content = $response->content;
my ($auth) = $content =~ /^Auth=(.*)YouTubeUser(.*)$/msg
or die "Unable to authenticate?\n";
my ($user) = $content =~ /YouTubeUser=(.*)$/msg
or die "Could not extract user name from response string. ";
return ($auth, $user);
}
And I call that from the main part of my program as such:
## Get $AuthToken
my ($AuthToken, $GoogleUserName) = getToken((
username => $email, password => $password
));
Once I have these two things -- $AuthToken and $GoogleUserName, I'm still testing the LWP Post. I'm still writing this unit:
sub test {
my %parms = #_;
## Copy file contents. Use, foy's three param open method.
my $fileSize = -s $parms{'File'};
open(VideoFile, '<', "$parms{'File'}") or die "Can't open $parms{'File'}.";
binmode VideoFile;
read(VideoFile, my $fileContents, $fileSize) or die "Can't read $parms{'File'}";
close VideoFile;
my $r = LWP::UserAgent->new->post(
"http://uploads.gdata.youtube.com/feeds/api/users/$parms{'user'}/uploads",
[
Host => "uploads.gdata.youtube.com",
'Authorization' => "AuthSub token=\"$parms{'auth'}\"",
'GData-Version' => "2",
'X-GData-Key' => "key=$YouTubeDeveloperKey",
'Slug' => "$parms{'File'}",
'Content-Type' => "multipart/related; boundary=\"<boundary_string>\"",
'Content-Length' => "<content_length>",
'video_content_type'=> "video/wmv",
'Connection' => "close",
'Content' => $fileContents
]
);
print Dumper(\$r->content)
}
And that is called as
&test((auth=>$Auth, user=>$user, File=>'test.wmv'));