fix: Mails sent from WebGUI now wrap at 78 characters to prevent a problem with SMTP servers that do not accept lines longer than 998 characters. This is per the SMTP RFCs. Added testing for this fix, still much to test for WebGUI::Mail::Send. Added API method to facilitate testing.
This commit is contained in:
Doug Bell
parent
1127d9dff2
commit
338c494d47
4 changed files with 222 additions and 67 deletions
|
|
@ -23,6 +23,11 @@
|
|||
widgetize and templateId is the template for the widget itself. If
|
||||
templateId isn't specified, uses ajaxInlineView.
|
||||
|
||||
7.4.21
|
||||
- fix: Mails sent from WebGUI now wrap at 78 characters, as the SMTP
|
||||
RFC asks, to fix problems with some SMTP servers when lines exceed
|
||||
998 characters.
|
||||
|
||||
7.4.20
|
||||
- fix: Assets with no committed versions may be left as orphans when parent is purged
|
||||
- fix: Tag cloud limited was to 50 least commonly used tags
|
||||
|
|
|
|||
|
|
@ -15,10 +15,11 @@ http://www.plainblack.com info@plainblack.com
|
|||
=cut
|
||||
|
||||
use strict;
|
||||
use Net::SMTP;
|
||||
use LWP::MediaTypes qw(guess_media_type);
|
||||
use MIME::Entity;
|
||||
use MIME::Parser;
|
||||
use LWP::MediaTypes qw(guess_media_type);
|
||||
use Net::SMTP;
|
||||
use Text::Wrap;
|
||||
use WebGUI::Group;
|
||||
use WebGUI::Macro;
|
||||
use WebGUI::User;
|
||||
|
|
@ -72,7 +73,7 @@ sub addAttachment {
|
|||
my $self = shift;
|
||||
my $path = shift;
|
||||
my $mimetype = shift || guess_media_type($path);
|
||||
$self->{_message}->attach(
|
||||
$self->getMimeEntity->attach(
|
||||
Path=>$path,
|
||||
Encoding=>'-SUGGEST',
|
||||
Type=>$mimetype
|
||||
|
|
@ -114,7 +115,7 @@ sub addHeaderField {
|
|||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
$self->{_message}->head->add($name, $value);
|
||||
$self->getMimeEntity->head->add($name, $value);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -163,13 +164,21 @@ A string of HTML.
|
|||
=cut
|
||||
|
||||
sub addHtmlRaw {
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
$self->{_message}->attach(
|
||||
Charset=>"UTF-8",
|
||||
Data=>$text,
|
||||
Type=>"text/html"
|
||||
);
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
|
||||
# Wrap text after 78 characters
|
||||
local $Text::Wrap::columns = 78;
|
||||
# Do not break up words
|
||||
local $Text::Wrap::huge = "overflow";
|
||||
|
||||
$self->getMimeEntity->attach(
|
||||
Charset => "UTF-8",
|
||||
Data => wrap( '', '', $text ),
|
||||
Type => "text/html",
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -186,12 +195,20 @@ A string of text.
|
|||
=cut
|
||||
|
||||
sub addText {
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
$self->{_message}->attach(
|
||||
Charset=>"UTF-8",
|
||||
Data=>$text
|
||||
);
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
|
||||
# Wrap text after 78 characters
|
||||
local $Text::Wrap::columns = 78;
|
||||
# Do not break up words
|
||||
local $Text::Wrap::huge = "overflow";
|
||||
|
||||
$self->getMimeEntity->attach(
|
||||
Charset => "UTF-8",
|
||||
Data => wrap( '', '', $text ),
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -335,6 +352,18 @@ sub getMessageIdsInQueue {
|
|||
return $session->db->buildArrayRef("select messageId from mailQueue");
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getMimeEntity ( )
|
||||
|
||||
Returns the MIME::Entity object associated with this mail message.
|
||||
|
||||
=cut
|
||||
|
||||
sub getMimeEntity {
|
||||
my $self = shift;
|
||||
return $self->{_message};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
@ -346,7 +375,7 @@ Puts this message in the mail queue so it can be sent out later by the workflow
|
|||
|
||||
sub queue {
|
||||
my $self = shift;
|
||||
return $self->session->db->setRow("mailQueue", "messageId", { messageId=>"new", message=>$self->{_message}->stringify, toGroup=>$self->{_toGroup} });
|
||||
return $self->session->db->setRow("mailQueue", "messageId", { messageId=>"new", message=>$self->getMimeEntity->stringify, toGroup=>$self->{_toGroup} });
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -370,7 +399,7 @@ sub replaceHeaderField {
|
|||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
$self->{_message}->head->replace($name, $value);
|
||||
$self->getMimeEntity->head->replace($name, $value);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -413,54 +442,61 @@ Sends the message via SMTP. Returns 1 if successful.
|
|||
=cut
|
||||
|
||||
sub send {
|
||||
my $self = shift;
|
||||
my $status = 1;
|
||||
if ($self->{_message}->head->get("To")) {
|
||||
if ($self->session->setting->get("smtpServer") =~ /\/sendmail/) {
|
||||
if (open(MAIL,"| ".$self->session->setting->get("smtpServer")." -t -oi -oem")) {
|
||||
$self->{_message}->print(\*MAIL);
|
||||
close(MAIL) or $self->session->errorHandler->error("Couldn't close connection to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
} else {
|
||||
$self->session->errorHandler->error("Couldn't connect to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
$status = 0;
|
||||
}
|
||||
} else {
|
||||
my $smtp = Net::SMTP->new($self->session->setting->get("smtpServer")); # connect to an SMTP server
|
||||
if (defined $smtp) {
|
||||
$smtp->mail($self->{_message}->head->get("X-Return-Path"));
|
||||
$smtp->to(split(",",$self->{_message}->head->get("to")));
|
||||
$smtp->cc(split(",",$self->{_message}->head->get("cc")));
|
||||
$smtp->bcc(split(",",$self->{_message}->head->get("bcc")));
|
||||
$smtp->data(); # Start the mail
|
||||
$smtp->datasend($self->{_message}->stringify);
|
||||
$smtp->dataend(); # Finish sending the mail
|
||||
$smtp->quit; # Close the SMTP connection
|
||||
} else {
|
||||
$self->session->errorHandler->error("Couldn't connect to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
$status = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
# due to the large number of emails that may be generated by sending emails to a group,
|
||||
# emails to members of a group are queued rather than sent directly
|
||||
my $group = $self->{_toGroup};
|
||||
delete $self->{_toGroup};
|
||||
if ($group) {
|
||||
my $group = WebGUI::Group->new($self->session, $group);
|
||||
my $self = shift;
|
||||
my $mail = $self->getMimeEntity;
|
||||
|
||||
my $status = 1;
|
||||
if ($mail->head->get("To")) {
|
||||
if ($self->session->setting->get("smtpServer") =~ /\/sendmail/) {
|
||||
if (open(MAIL,"| ".$self->session->setting->get("smtpServer")." -t -oi -oem")) {
|
||||
$mail->print(\*MAIL);
|
||||
close(MAIL) or $self->session->errorHandler->error("Couldn't close connection to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
}
|
||||
else {
|
||||
$self->session->errorHandler->error("Couldn't connect to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
$status = 0;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $smtp = Net::SMTP->new($self->session->setting->get("smtpServer")); # connect to an SMTP server
|
||||
if (defined $smtp) {
|
||||
$smtp->mail($mail->head->get("X-Return-Path"));
|
||||
$smtp->to(split(",",$mail->head->get("to")));
|
||||
$smtp->cc(split(",",$mail->head->get("cc")));
|
||||
$smtp->bcc(split(",",$mail->head->get("bcc")));
|
||||
$smtp->data(); # Start the mail
|
||||
$smtp->datasend($mail->stringify);
|
||||
$smtp->dataend(); # Finish sending the mail
|
||||
$smtp->quit; # Close the SMTP connection
|
||||
}
|
||||
else {
|
||||
$self->session->errorHandler->error("Couldn't connect to mail server: ".$self->session->setting->get("smtpServer"));
|
||||
$status = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# due to the large number of emails that may be generated by sending emails to a group,
|
||||
# emails to members of a group are queued rather than sent directly
|
||||
my $group = $self->{_toGroup};
|
||||
delete $self->{_toGroup};
|
||||
if ($group) {
|
||||
my $group = WebGUI::Group->new($self->session, $group);
|
||||
return $status
|
||||
if !defined $group;
|
||||
$self->{_message}->head->replace("bcc", undef);
|
||||
$self->{_message}->head->replace("cc", undef);
|
||||
foreach my $userId (@{$group->getAllUsers(1)}) {
|
||||
my $user = WebGUI::User->new($self->session, $userId);
|
||||
if !defined $group;
|
||||
$mail->head->replace("bcc", undef);
|
||||
$mail->head->replace("cc", undef);
|
||||
foreach my $userId (@{$group->getAllUsers(1)}) {
|
||||
my $user = WebGUI::User->new($self->session, $userId);
|
||||
next unless $user->status eq 'Active'; ##Don't send this to invalid user accounts
|
||||
if ($user->profileField("email")) {
|
||||
$self->{_message}->head->replace("To",$user->profileField("email"));
|
||||
$self->queue;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $status;
|
||||
if ($user->profileField("email")) {
|
||||
$mail->head->replace("To",$user->profileField("email"));
|
||||
$self->queue;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $status;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
113
t/Mail/Send.t
Normal file
113
t/Mail/Send.t
Normal file
|
|
@ -0,0 +1,113 @@
|
|||
# vim:syntax=perl
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2007 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#------------------------------------------------------------------
|
||||
|
||||
# This script tests the creation, sending, and queuing of mail messages
|
||||
# TODO: There is plenty left to do in this script.
|
||||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
use WebGUI::Test;
|
||||
|
||||
use WebGUI::Mail::Send;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
my $mail; # The WebGUI::Mail::Send object
|
||||
my $mime; # for getMimeEntity
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
plan tests => 5; # Increment this number for each test you create
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Test create
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
isa_ok( $mail, 'WebGUI::Mail::Send',
|
||||
"WebGUI::Mail::Send->create returns a WebGUI::Mail::Send object",
|
||||
);
|
||||
|
||||
# Test that getMimeEntity works
|
||||
$mime = $mail->getMimeEntity;
|
||||
isa_ok( $mime, 'MIME::Entity',
|
||||
"getMimeEntity",
|
||||
);
|
||||
|
||||
# Test that create gets the appropriate defaults
|
||||
# TODO
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Test addText
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
my $text = <<'EOF';
|
||||
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Suspendisse eu lacus ut ligula fringilla elementum. Cras condimentum, velit commodo pretium semper, odio ante accumsan orci, a ultrices risus justo a nulla. Aliquam erat volutpat.
|
||||
EOF
|
||||
|
||||
$mail->addText($text);
|
||||
$mime = $mail->getMimeEntity;
|
||||
|
||||
# addText should add newlines after 78 characters
|
||||
my $newlines = length $text / 78;
|
||||
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
||||
"addText should add newlines after 78 characters",
|
||||
);
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Test addHtml
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
my $text = <<'EOF';
|
||||
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Suspendisse eu lacus ut ligula fringilla elementum. Cras condimentum, velit commodo pretium semper, odio ante accumsan orci, a ultrices risus justo a nulla. Aliquam erat volutpat.
|
||||
EOF
|
||||
|
||||
$mail->addHtml($text);
|
||||
$mime = $mail->getMimeEntity;
|
||||
|
||||
# TODO: Test that addHtml creates an HTML wrapper if no html or body tag exists
|
||||
# TODO: Test that addHtml creates a body with the right content type
|
||||
|
||||
# addHtml should add newlines after 78 characters
|
||||
my $newlines = length $text / 78;
|
||||
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
||||
"addHtml should add newlines after 78 characters",
|
||||
);
|
||||
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
# TODO: Test that addHtml does not create an HTML wrapper if html or body tag exist
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Test addHtmlRaw
|
||||
$mail = WebGUI::Mail::Send->create( $session );
|
||||
my $text = <<'EOF';
|
||||
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Suspendisse eu lacus ut ligula fringilla elementum. Cras condimentum, velit commodo pretium semper, odio ante accumsan orci, a ultrices risus justo a nulla. Aliquam erat volutpat.
|
||||
EOF
|
||||
|
||||
$mail->addHtmlRaw($text);
|
||||
$mime = $mail->getMimeEntity;
|
||||
|
||||
# TODO: Test that addHtmlRaw doesn't add an HTML wrapper
|
||||
|
||||
# addHtmlRaw should add newlines after 78 characters
|
||||
my $newlines = length $text / 78;
|
||||
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
|
||||
"addHtmlRaw should add newlines after 78 characters",
|
||||
);
|
||||
|
||||
# TODO: Test that addHtml creates a body with the right content type
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Cleanup
|
||||
END {
|
||||
|
||||
}
|
||||
|
|
@ -17,14 +17,13 @@ use FindBin;
|
|||
use strict;
|
||||
use lib "$FindBin::Bin/lib";
|
||||
use Test::More;
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Test;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
|
@ -38,3 +37,5 @@ plan tests => 1; # Increment this number for each test you create
|
|||
#----------------------------------------------------------------------------
|
||||
# Cleanup
|
||||
END {
|
||||
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue