Perl sendmail to list is truncated - perl

I am working with a perl based cgi pages for a webproject. I am encountering a strange problem with sendmail module which happens randomly.
Problem:
Sendmail would truncate the emails of the users appended at last. But not always, it happens randomly. I log the email list right before sending email and I don't see anything wrong.
Example Image (See Karl's last name is truncated at '.' after his first name.)
Headers for the email.
Message-ID: <201305221503.r4MF3dYf022792#pazmo.internal.company.com>
Subject: < ...>
MIME-Version: 1.0
Content-Type: text/plain
To: <biradavolu.ln#company.com>, <dessimira.ln#company.com>,
<yun.ln#company.com>, karl.
Date: Wed, 22 May 2013 10:03:39 -0500
From: <tool#company.com>
Return-Path: tool#company.com
X-MS-Exchange-Organization-AuthSource: eusaamw0712.domain.company.com
X-MS-Exchange-Organization-AuthAs: Internal
X-MS-Exchange-Organization-AuthMechanism: 10
X-MS-Exchange-Organization-AVStamp-Mailbox: MSFTFF;1;0;0 0 0
The logged input before sending email: ( I don't see anything wrong with the format)
biradavolu.ln#company.com;dessimira.ln#company.com;yun.lastName#company.com;karl.LastName#company.com;
use Mail::Sendmail;
# Step 1: Declare the mail variable
%mail = (
from => 'test#company.com',
to => 'user1FN.user1LN#company.com;user2FN.user2LN#company.com;user3FN.user3LN#company.com;' . "$requester_email; $responsible_email",
subject => ... ,
'content-type' => "multipart/alternative; "
);
my $toList='user1FN.user1LN#company.com;user2FN.user2LN#company.com;user3FN.user3LN#company.com;' . "$requester_email;";
# Step 2: Add members to toList based on different conditions
if(condition1)
$toList= $toList.'user4FN.user4LN#company.com;';
if(condition2)
$toList= $toList.'user5FN.user5LN#company.com;';
... # few other similar condition statement
...
# Step 3: Assign toList based on different conditions
$mail{ 'to' } = $toList;
# Step 4: Set Body of the $mail
if(sendmail(%mail)){
print LOGFILE "Mail send successfully to $mail{\"to\"}: ";
}else{
print LOGFILE "Mail was not send : Mail list was $mail{\"to\"} : ";
}

Wild guess here. You're hiding the actual lastnames of your users (which is fine), but it could be possible that the "random" truncating is always happening on a user with a space in the last name? Like "St. Pierre". Your string might get truncated right at the space.
Let me know if that's possible!

Related

Parsing email with Email::MIME and multipart/signed

I'm a perl novice trying to figure out how to decode a MIME-encoded email with multiple parts. I'm not sure of conventions, so I'll just include the pieces of the email that I believe are relevant:
Content-Type: multipart/mixed; boundary="===============3385789078715843912=="
Mime-Version: 1.0
--===============3385789078715843912==
Content-Type: multipart/signed; micalg="pgp-sha256";
protocol="application/pgp-signature"; boundary="=-0+dmFxz+BsFOEAAxvudu"
--=-0+dmFxz+BsFOEAAxvudu
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: base64
PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09
PT09PT09PT09PT09PT09PT0KVWJ1bnR1IFNlY3VyaXR5IE5vdGljZSBVU04tMzIxMC0xCkZlYnJ1
YXJ5IDIzLCAyMDE3CgpMaWJyZU9mZmljZSB2dWxuZXJhYmlsaXR5Cj09PT09PT09PT09PT09PT09
PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09
CgpBIHNlY3VyaXR5IGlzc3VlIGFmZmVjdHMgdGhlc2UgcmVsZWFzZXMgb2YgVWJ1bnR1IGFuZCBp
dHMgZGVyaXZhdGl2ZXM6CgotIFVidW50dSAxNi4wNCBMVFMKLSBVYnVudHUgMTQuMDQgTFRTCi0g
I've got the following bit of code:
my $msg = Email::MIME->new($buf);
for my $part ($msg->parts) {
if ($part->content_type =~ m!multipart/mixed!
or $part->content_type eq '' )
{
print "Found Multipart";
for my $subpart ($part->parts) {
print $subpart->body;
}
}
}
I really don't know what to do next. I've had a dozen different variations on this, and haven't gotten any closer after four hours of working on it. I'd appreciate if someone could help me identify the proper perl modules and functions to be used to read this text sub-part of a signed email.
The documentation of Email::MIME suggests not to use parts, because it's a stupid method. It returns its own object if there are no parts. That is weird.
Instead use the subparts method to get the parts of the email. Then use it again to iterate all parts of that part. If there are any, it will go in. Print the body of that sub part and you're done.
foreach my $part ( $msg->subparts ) {
foreach my $sub_part ($part->subparts) {
print $sub_part->body;
}
}

Can't call method "verify" on an undefined value

• 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.

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.

Sending email to multiple recipients

I've moved some old code from an old unix box to our new unix box, and I'm having some difficulty with a perl script sending email to multiple recipients. It works on the old box.
Old box perl: version 5.004_04 built for PA-RISC2.0
New box perl: v5.8.8 built for IA64.ARCHREV_0-thread-multi-LP64
Here's the basics of the script (stripped-down):
use Net::SMTP::Multipart;
$to = "sam\#bogus.com tom\#foo.com";
$smtp = Net::SMTP::Multipart->new($smtpserver);
$smtp->Header(To => $to,
From => "junk\#junk.com",
Subj => "This is a test.");
$smtp->Text("Hello, world!\n");
$smtp->End();
This works if I change it to $to = "justOneEmail\#address.com", but if I have two or more email addresses (separated by spaces), it no longer works. I don't get an error message, but no message shows up.
Any ideas why?
Do it like this:
use Net::SMTP::Multipart;
$to1 = "sam\#bogus.com";
$to2 = 'tom#foo.com';
$smtp = Net::SMTP::Multipart->new($smtpserver);
$smtp->Header(To => [ $to1, $to2, 'another_email#server.com' ],
From => "junk\#junk.com",
Subj => "This is a test.");
$smtp->Text("Hello, world!\n");
$smtp->End();
Notice that if you use double-quotes, you should escape the # in the email addresses, or perl may try to interpret it as an array interpolation.
Instead of separating the email addresses with spaces, use a comma with no intervening spaces. This works for me..
Declare an array and put all the email id's like
#MailTo = ('mail1#demomail.com', 'mail2#demomail.com', ...., 'mailn#demomail.com')
Now use the Net::SMTP module to send out the emails
$smtp->to(#MailTo);

base64-Encoding breaks smime-encrypted emaildata

I'm using Mime::Lite to create and send E-Mails. Now I need to add support for S/Mime-encryption and finally could encrypt my E-Mail (the only Perllib I could install seems broken, so I'm using a systemcall and openssl smime), but when I try to create a mime-object with it, the E-Mail will be broken as soon as I set the Content-Transfer-Encoding to base64. To make it even more curious, it happens only if I set it via $myMessage->attr. If I'm using the constructor ->new everything is fine, besides a little warning which I suppress by using MIME::Lite->quiet(1);
Is it a bug or my fault? Here are the two ways how I create the mime-object.
Setting the Content-Transfer-Encoding via construtor and suppress the warning:
MIME::Lite->quiet(1);
my $msgEncr = MIME::Lite->new(From =>'me#myhost.com',
To => 'you#yourhost.com',
Subject => 'SMIME Test',
Data => $myEncryptedMessage,
'Content-Transfer-Encoding' => 'base64');
$msgEncr->attr('Content-Disposition' => 'attachment');
$msgEncr->attr('Content-Disposition.filename' => 'smime.p7m');
$msgEncr->attr('Content-Type' => 'application/x-pkcs7-mime');
$msgEncr->attr('Content-Type.smime-type' => 'enveloped-data');
$msgEncr->attr('Content-Type.name' => 'smime.p7m');
$msgEncr->send;
MIME::Lite->quiet(0);
Setting the Content-Transfer-Encoding via $myMessage->attr which breaks the encrypted Data, but won't cause a warning:
my $msgEncr = MIME::Lite->new(From => 'me#myhost.com',
To => 'you#yourhost.com',
Subject => 'SMIME Test',
Data => $myEncryptedMessage);
$msgEncr->attr('Content-Disposition' => 'attachment');
$msgEncr->attr('Content-Disposition.filename' => 'smime.p7m');
$msgEncr->attr('Content-Type' => 'application/x-pkcs7-mime');
$msgEncr->attr('Content-Type.smime-type' => 'enveloped-data');
$msgEncr->attr('Content-Type.name' => 'smime.p7m');
$msgEncr->attr('Content-Transfer-Encoding' => 'base64');
$msgEncr->send;
I just don't get why my message is broken when I'm using the attribute-setter. Thanks in advance for your help!
Besides that i'm unable to attach any file to this E-Mail without breaking the encrypted message again.
To debug this
Make a script call showmail.pl
#!/usr/bin/perl
while (<STDIN>) { print $_; }
Test it like
use MIME::Lite;
use Net::SMTP;
use MIME::Base64;
$myEncryptedMessage = encode_base64("This is not valid encrypted message\n");
MIME::Lite->send('sendmail', "./showmail.pl"); ## Add this for debugging.
MIME::Lite->quiet(1); my $msgEncr = MIME::Lite->new(From =>'me#localhost',
To => 'you#localhost',
Subject => 'SMIME Test',
Data => $myEncryptedMessage,
'Content-Transfer-Encoding' => 'base64');
$msgEncr->attr('Content-Disposition' => 'attachment');
$msgEncr->attr('Content-Disposition.filename' => 'smime.p7m');
$msgEncr->attr('Content-Type' => 'application/x-pkcs7-mime');
$msgEncr->attr('Content-Type.smime-type' => 'enveloped-data');
$msgEncr->attr('Content-Type.name' => 'smime.p7m');
$msgEncr->send();
you should see something like.
MIME-Version: 1.0
Content-Disposition: attachment; filename="smime.p7m"
Content-Length: 49
Content-Type: application/x-pkcs7-mime; name="smime.p7m"; smime-type="enveloped-data"
X-Mailer: MIME::Lite 3.028 (F2.74; B3.07; Q3.07)
Date: Mon, 23 Mar 2012 10:40:51 -0400
From: me#localhost
To: you#localhost
Subject: SMIME Test
Content-Transfer-Encoding: base64
VGhpcyBpcyBub3QgdmFsaWQgZW5jcnlwdGVkIG1lc3NhZ2UK
The message is encoded base64, but the real message still needs to be correctly
encypted. You need to make sure that is the case since $myEncryptedMessage is
passed in. With the debug output, you can compare with a known good encrypted mail
and see if the headers are good, as far as I can see the headers are fine, it is probably
the data that is not valid.
I am not able to test this with a real mail client, but this is what I think may work for multi-parts.
use MIME::Lite;
use Net::SMTP;
use MIME::Base64;
MIME::Lite->send('sendmail', "./showmail.pl"); ## <---- for testing only
my $from_address = "nobody#localhost";
my $to_address = "somebody#localhost";
my $mail_host = "localhost";
my $subject = "Subject list";
my $message_body = "Attachment list";
my #files = ("crypt.data1","crypt.data2");
$msg = MIME::Lite->new (
From => $from_address,
To => $to_address,
Subject => $subject,
Type =>'multipart/mixed'
) or die "Error creating multipart container: $!\n";
foreach $c(#files) {
$msg->attach (
Disposition => 'attachment',
Type => "application/x-pkcs7-mime; name=smime.p7m; smime-type=enveloped-data",
Path => $c,
) or die "Error adding $c: $!\n";
}
$msg->send;
As I said in one comment the difference in setting the encoding in the construtor of the mimeobject or with the ->attr-Setter is, that the construtor just sets the encoding in the mimeheader. By using the ->attr-Setter mime encodes the data with base64.
So in my case, my previously generated mimeobject - which is base64-encoded and with s/mime encrypted - read from a file needs to set the encoding in the construtor (and suppress the warning) so no more encoding will be done by mime. Otherwise mime will encode the data again and therefore break the encryption and the email itself.
I finally got attachments to work. To achieve this I create a normal multipart/mixed mimeobject, print this object into a normal file, encrypt this file with openssl smime, read this whole file (except the 6 headerlines) into a variable and use this as the datainput. Additionally I set the Content-Transfer-Encoding to base64 using the construtor (so no encoding is done to my data).
I hope this will help someone else then me ;)
Replace $myEncryptedMessage with encode_base64($myEncryptedMessage)
and use MIME::Base64;