From 338c494d4712c351b8f6e3c5dcde53fd61b11227 Mon Sep 17 00:00:00 2001 From: Doug Bell Date: Sat, 12 Jan 2008 07:46:32 +0000 Subject: [PATCH] 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. --- docs/changelog/7.x.x.txt | 5 ++ lib/WebGUI/Mail/Send.pm | 166 ++++++++++++++++++++++++--------------- t/Mail/Send.t | 113 ++++++++++++++++++++++++++ t/_test.skeleton | 5 +- 4 files changed, 222 insertions(+), 67 deletions(-) create mode 100644 t/Mail/Send.t diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 627166077..8ce9772a5 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -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 diff --git a/lib/WebGUI/Mail/Send.pm b/lib/WebGUI/Mail/Send.pm index ac4f5aac7..aa4dcad76 100644 --- a/lib/WebGUI/Mail/Send.pm +++ b/lib/WebGUI/Mail/Send.pm @@ -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; } #------------------------------------------------------------------- diff --git a/t/Mail/Send.t b/t/Mail/Send.t new file mode 100644 index 000000000..1dddc21bf --- /dev/null +++ b/t/Mail/Send.t @@ -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 { + +} diff --git a/t/_test.skeleton b/t/_test.skeleton index a858da30c..b98cac7f6 100644 --- a/t/_test.skeleton +++ b/t/_test.skeleton @@ -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 { + +}