Merge branch 'mailcommand'
This commit is contained in:
Arjan Widlak
commit
b9aaf63ec2
9 changed files with 478 additions and 85 deletions
101
docs/mail_commands_setup.pod
Normal file
101
docs/mail_commands_setup.pod
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
=head1 Configuring WebGUI mail commands
|
||||
|
||||
This document discusses the steps required to tie WebGUI mal command into
|
||||
postfix.
|
||||
|
||||
=head2 Setting up WebGUI
|
||||
|
||||
The mappings between To adress in the incoming emails and WebGUI instances is
|
||||
defined in /data/WebGUI/etc/mailing_dispatch.config. This is a JSON file
|
||||
containing a hash with domain to instance config file mappings:
|
||||
|
||||
{
|
||||
"mailing.domain1.com" : "www_domain1_com.conf",
|
||||
"newsletter.foo.com" : "www_foo_com.conf"
|
||||
}
|
||||
|
||||
Note that any domain can be tied to any config file: domains don't have to
|
||||
match. The only requirement is that the server can receive mail on the given
|
||||
domain. Eg. the following is a valid mapping
|
||||
|
||||
{
|
||||
"newsletter.bar.com" : "www_xyzzy_com.conf"
|
||||
}
|
||||
|
||||
It is also possible to map multiple domains to a single config file, eg.
|
||||
|
||||
{
|
||||
"mailing.example.com" : "example_com.conf",
|
||||
"mailing.foobar.org" : "example_com.conf"
|
||||
}
|
||||
|
||||
However it is not allowed to map a single domain to multiple config files. If
|
||||
you do the instance that is used, is not defined. Eg. the following is NOT
|
||||
allowed.
|
||||
|
||||
{
|
||||
"mailing.example.com" : "example_com.conf",
|
||||
"mailing.example.com" : "foobar_org.conf"
|
||||
}
|
||||
|
||||
|
||||
=head2 Setting up Postfix
|
||||
|
||||
The newsletter-transport.pl script in the webgui_newsletter sbin directory
|
||||
acts as a bridge between postfix and WebGUI. It is intended to be invoked
|
||||
by postfix's pipe command.
|
||||
|
||||
=head3 Configuring master.cf
|
||||
|
||||
We need a queue that processes mail intended for WebGUI. To do so add the
|
||||
following to /etc/postfix/master.cf:
|
||||
|
||||
wgml unix - n n - - pipe
|
||||
flags=FR user=webgui argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl \
|
||||
--domain=${domain} --user=${user} --sender=${sender} --senderIp=${client_address}
|
||||
|
||||
This creates a queue called wgml that pipes all mail in it through the
|
||||
newsletter-transport.pl script. Make sure that the user parameter is set correctly and argv
|
||||
contains the full path to the newsletter-transport.pl script.
|
||||
|
||||
|
||||
=head3 Setup a transport map
|
||||
|
||||
In order to determine which emails should go to the wgml queue, create a
|
||||
mapping in /etc/postfix/wg_mailer_transport. There are more ways to do this.
|
||||
|
||||
If you use a dedicated maildomain used solely for receiving WebGUI mail
|
||||
commands add a line like the following for each mail domain in your
|
||||
/date/WebGUI/etc/mailing_dispatch.config:
|
||||
|
||||
/@mailing.foo.com$/ wgml:
|
||||
/@newsletter.example.com$/ wgml:
|
||||
|
||||
If you use a domain that is not solely dedicated to receiving WebGUI mail
|
||||
commands, you can match on individual commands:
|
||||
|
||||
/^[a-zA-Z0-9_-]+-bounce@/ wgml:
|
||||
/^[a-zA-Z0-9_-]+-subscribe@/ wgml:
|
||||
|
||||
|
||||
Afterwards complile the mapping into a postfix lookup table
|
||||
|
||||
postmap /etc/postfix/wg_mailer_transport
|
||||
|
||||
You have to do this everytime you change the mapping.
|
||||
|
||||
=head3 Configuring main.cf
|
||||
|
||||
Now we need to tell postfix to use the mapping, and how to use the wgml
|
||||
queue. To do this add the following to /etc/postfix/main.cf:
|
||||
|
||||
smtpd_reject_unlisted_recipient = no
|
||||
transport_maps = regexp:/etc/postfix/wg_mailer_transport
|
||||
wgml_destination_recipient_limit = 1
|
||||
|
||||
Make sure you add the domains in your mailing_dispatch.config to the
|
||||
mydestination directlive in main.cf:
|
||||
|
||||
mydestination = mailing.foo.com, newsletter.example.org, some.other.domain
|
||||
|
||||
Finally restart postfix.
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
Add to /etc/postfix/main.cf:
|
||||
smtpd_reject_unlisted_recipient = no
|
||||
transport_maps = regexp:/etc/postfix/wg_mailer_transport
|
||||
wgml_destination_recipient_limit = 1
|
||||
|
||||
Add to /etc/postfix/master.cf:
|
||||
wgml unix - n n - - pipe
|
||||
flags=FR user=martin argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl ${domain} ${user}
|
||||
|
||||
|
||||
Create /etc/postfix/wg_mailer_transport:
|
||||
/^[a-zA-Z0-9]+-bounce@/ wgml:
|
||||
|
||||
And run:
|
||||
postmap /etc/postfix/wg_mailer_transport
|
||||
|
||||
Finally restart postfix.
|
||||
|
|
@ -2,11 +2,18 @@ package WebGUI::AssetAspect::Subscriber;
|
|||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::C3;
|
||||
use 5.010;
|
||||
use Class::C3;
|
||||
use Carp;
|
||||
|
||||
use WebGUI::Asset::Template;
|
||||
use WebGUI::Macro;
|
||||
use WebGUI::Mail::Send;
|
||||
use WebGUI::Group;
|
||||
use WebGUI::Asset;
|
||||
use WebGUI::Form;
|
||||
use WebGUI::User::SpecialState;
|
||||
use WebGUI::International;
|
||||
use Tie::IxHash;
|
||||
use URI;
|
||||
|
||||
|
|
@ -18,6 +25,11 @@ sub definition {
|
|||
my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' );
|
||||
|
||||
tie my %properties, 'Tie::IxHash', (
|
||||
listName => {
|
||||
fieldType => 'text',
|
||||
label => $i18n->echo("List name"),
|
||||
tab => 'subscription',
|
||||
},
|
||||
subscriptionGroupId => {
|
||||
fieldType => 'subscriptionGroup',
|
||||
label => $i18n->get( 'Subscription group' ),
|
||||
|
|
@ -33,7 +45,7 @@ sub definition {
|
|||
alwaysConfirmSubscription => {
|
||||
fieldType => 'yesNo',
|
||||
defaultValue => 0,
|
||||
label => $i18n->get( 'require confirmation' ),
|
||||
label => $i18n->get( 'require confirmation' ),
|
||||
tab => 'subscription',
|
||||
},
|
||||
allowAnonymousSubscription => {
|
||||
|
|
@ -116,7 +128,7 @@ sub getListHeaders {
|
|||
my $site = $self->session->url->getSiteURL;
|
||||
|
||||
my $headers = {
|
||||
'List-Unsubscribe' =>
|
||||
'List-Unsubscribe' =>
|
||||
'<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>',
|
||||
'List-Subscribe' =>
|
||||
'<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>',
|
||||
|
|
@ -180,13 +192,13 @@ sub appendSubscriptionFormVars {
|
|||
my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
|
||||
|
||||
# Setup form controls
|
||||
my $formHeader =
|
||||
my $formHeader =
|
||||
WebGUI::Form::formHeader( $session, { action => $self->getUrl } )
|
||||
. WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } )
|
||||
;
|
||||
my $subscribeButton =
|
||||
my $subscribeButton =
|
||||
sprintf '<button type="submit" name="action" value="subscribe">%s</button>', $i18n->get('subscribe');
|
||||
my $unsubscribeButton =
|
||||
my $unsubscribeButton =
|
||||
sprintf '<button type="submit" name="action" value="unsubscribe">%s</button>', $i18n->get('unsubscribe');
|
||||
my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } );
|
||||
my $formFooter = WebGUI::Form::formFooter( $session );
|
||||
|
|
@ -219,8 +231,8 @@ sub appendSubscriptionFormVars {
|
|||
sub getSubscriptionGroup {
|
||||
my $self = shift;
|
||||
my $groupId = $self->get( "subscriptionGroupId" );
|
||||
my $group = $groupId
|
||||
? WebGUI::Group->new( $self->session, $groupId )
|
||||
my $group = $groupId
|
||||
? WebGUI::Group->new( $self->session, $groupId )
|
||||
: $self->createSubscriptionGroup
|
||||
;
|
||||
|
||||
|
|
@ -231,7 +243,7 @@ sub getSubscriptionGroup {
|
|||
sub getReturnUrl {
|
||||
my $self = shift;
|
||||
my $referer = $self->session->env->get('HTTP_REFERER');
|
||||
|
||||
|
||||
return unless $referer;
|
||||
|
||||
# Get path and strip leading and trailing slash if it exists.
|
||||
|
|
@ -263,6 +275,45 @@ sub getEmailVars {
|
|||
return $var;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub getAssetByListName {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $listName = shift || return;
|
||||
my $db = $session->db;
|
||||
|
||||
my $assetId = $db->quickScalar( 'select assetId from assetAspectSubscriber where listName=? limit 1', [
|
||||
$listName
|
||||
] );
|
||||
|
||||
return unless $assetId;
|
||||
|
||||
my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
|
||||
|
||||
return $asset;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub processPropertiesFromFormPost {
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
my $form = $session->form;
|
||||
|
||||
my $listName = $form->get('listName');
|
||||
my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
|
||||
|
||||
my $errors = $self->next::method;
|
||||
|
||||
if ( $asset && $asset->getId ne $self->getId ) {
|
||||
return [
|
||||
@{ $errors || [] },
|
||||
"List name $listName is already taken."
|
||||
];
|
||||
}
|
||||
|
||||
return $errors;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub sendSubscriptionConfirmation {
|
||||
my $self = shift;
|
||||
|
|
@ -280,14 +331,18 @@ sub sendSubscriptionConfirmation {
|
|||
$var->{ actionIsSubscribe } = $action eq 'subscribe';
|
||||
|
||||
my $mail = WebGUI::Mail::Send->create( $self->session, {
|
||||
to => $user->get('email'),
|
||||
subject => $self->get('confirmationEmailSubject'),
|
||||
to => $user->get('email'),
|
||||
subject => $self->get('confirmationEmailSubject'),
|
||||
contentType => 'multipart/alternative',
|
||||
} );
|
||||
|
||||
my $templateId = $self->get('confirmationEmailTemplateId');
|
||||
my $template = WebGUI::Asset::Template->new( $session, $templateId );
|
||||
if ( $template ) {
|
||||
$mail->addHtml( $template->process( $var ) );
|
||||
my $content = $template->process( $var );
|
||||
|
||||
$mail->addHtml( $content );
|
||||
$mail->addText( $self->transformToText( $content ) );
|
||||
}
|
||||
else {
|
||||
$session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" );
|
||||
|
|
@ -311,14 +366,18 @@ sub sendNoMutationEmail {
|
|||
$var->{ actionIsSubscribe } = $action eq 'subscribe';
|
||||
|
||||
my $mail = WebGUI::Mail::Send->create( $self->session, {
|
||||
to => $user->get('email'),
|
||||
subject => $self->get('noMutationEmailSubject'),
|
||||
to => $user->get('email'),
|
||||
subject => $self->get('noMutationEmailSubject'),
|
||||
contentType => 'multipart/alternative',
|
||||
} );
|
||||
|
||||
my $templateId = $self->get('noMutationEmailTemplateId');
|
||||
my $template = WebGUI::Asset::Template->new( $session, $templateId );
|
||||
if ( $template ) {
|
||||
$mail->addHtml( $template->process( $var ) );
|
||||
my $content = $template->process( $var );
|
||||
|
||||
$mail->addHtml( $content );
|
||||
$mail->addText( $self->transformToText( $content ) );
|
||||
}
|
||||
else {
|
||||
$session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" );
|
||||
|
|
@ -332,6 +391,18 @@ sub sendNoMutationEmail {
|
|||
return;
|
||||
}
|
||||
|
||||
sub transformToText {
|
||||
my $self = shift;
|
||||
my $html = shift;
|
||||
|
||||
my $text = $html;
|
||||
#HTML::Entities::decode($text);
|
||||
$text =~ s/<a.*?href=["'](.*?)['"].*?>(.+?)<\/a>/$2 ($1)/g;
|
||||
$text = WebGUI::HTML::html2text($text);
|
||||
|
||||
return $text;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub logConfirmation {
|
||||
my $self = shift;
|
||||
|
|
@ -339,7 +410,7 @@ sub logConfirmation {
|
|||
my $session = $self->session;
|
||||
my $db = $session->db;
|
||||
|
||||
$db->write(
|
||||
$db->write(
|
||||
' update assetAspectSubscriber_log set '
|
||||
.' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?',
|
||||
[
|
||||
|
|
@ -363,7 +434,7 @@ sub logRequest {
|
|||
my $session = $self->session;
|
||||
my $db = $session->db;
|
||||
|
||||
$db->write(
|
||||
$db->write(
|
||||
' insert into assetAspectSubscriber_log set '
|
||||
.' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?',
|
||||
[
|
||||
|
|
@ -389,6 +460,7 @@ sub subscribe {
|
|||
my $requireConfirm = shift // $self->get('alwaysConfirmSubscription');
|
||||
my $session = $self->session;
|
||||
|
||||
|
||||
if ( $requireConfirm ) {
|
||||
if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) {
|
||||
$self->sendNoMutationEmail( $user, 'subscribe' );
|
||||
|
|
@ -414,7 +486,7 @@ sub unsubscribe {
|
|||
my $self = shift;
|
||||
my $user = shift || $self->session->user;
|
||||
my $requireConfirm = shift // $self->get('alwaysConfirmSubscription');
|
||||
|
||||
|
||||
my $session = $self->session;
|
||||
|
||||
if ( $requireConfirm ) {
|
||||
|
|
@ -447,8 +519,8 @@ sub www_confirmMutation {
|
|||
my $code = $form->get('code');
|
||||
return unless $code;
|
||||
|
||||
my ($userId, $type) = $db->quickArray(
|
||||
'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?',
|
||||
my ($userId, $type) = $db->quickArray(
|
||||
'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?',
|
||||
[
|
||||
0,
|
||||
$code,
|
||||
|
|
@ -472,6 +544,40 @@ sub www_confirmMutation {
|
|||
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub subscribeAnonymous {
|
||||
my $self = shift;
|
||||
my $email = shift; # TODO || return ?
|
||||
my $session = $self->session;
|
||||
|
||||
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
|
||||
|
||||
# If email address doesn't have an account, create one.
|
||||
if ( !defined $emailUser ) {
|
||||
$emailUser = WebGUI::User::SpecialState->create( $session );
|
||||
$emailUser->update( { email => $email } );
|
||||
}
|
||||
$emailUser->addSpecialState( 'Subscriber', $self->getId );
|
||||
|
||||
$self->subscribe( $emailUser, 1 );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub unsubscribeAnonymous {
|
||||
my $self = shift;
|
||||
my $email = shift;
|
||||
my $session = $self->session;
|
||||
|
||||
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
|
||||
if ( defined $emailUser ) {
|
||||
$self->unsubscribe( $emailUser, 1 );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub www_processSubscription {
|
||||
my $self = shift;
|
||||
|
|
@ -496,18 +602,9 @@ sub www_processSubscription {
|
|||
my $email = $form->email( 'email' );
|
||||
return 'Error: no email address passed' unless $email;
|
||||
|
||||
my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email );
|
||||
if ( $action eq 'unsubscribe' && defined $emailUser ) {
|
||||
$self->unsubscribe( $emailUser, 1 );
|
||||
}
|
||||
if ( $action eq 'subscribe' ) {
|
||||
if ( !defined $emailUser ) {
|
||||
$emailUser = WebGUI::User::SpecialState->create( $session );
|
||||
$emailUser->update( { email => $email } );
|
||||
}
|
||||
$emailUser->addSpecialState( 'Subscriber', $self->getId );
|
||||
|
||||
$self->subscribe( $emailUser, 1 );
|
||||
given ( $action ) {
|
||||
when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); }
|
||||
when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); }
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
|
|||
56
lib/WebGUI/MailCommand.pm
Normal file
56
lib/WebGUI/MailCommand.pm
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
package WebGUI::MailCommand;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub isValidCommand {
|
||||
my $command = shift;
|
||||
|
||||
return defined resolveCommandClass( $command );
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $session = shift || die "Need a session";
|
||||
|
||||
bless { _session => $session }, $class;
|
||||
}
|
||||
|
||||
sub process {
|
||||
WebGUI::Error::OverrideMe->throw;
|
||||
}
|
||||
|
||||
sub processCommand {
|
||||
my $session = shift;
|
||||
my $command = shift;
|
||||
my $parameter = shift;
|
||||
my $sender = shift;
|
||||
|
||||
my $commandClass = resolveCommandClass( $command )
|
||||
|| return;
|
||||
|
||||
my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] );
|
||||
|
||||
return $commandObject->process( $parameter, $sender );
|
||||
}
|
||||
|
||||
sub session {
|
||||
return (shift)->{ _session };
|
||||
}
|
||||
|
||||
sub resolveCommandClass {
|
||||
my $command = shift;
|
||||
|
||||
# TODO: Do not hard code.
|
||||
my %commands = (
|
||||
unsubscribe => 'WebGUI::MailCommand::Unsubscribe',
|
||||
subscribe => 'WebGUI::MailCommand::Subscribe',
|
||||
bounce => 'WebGUI::MailCommand::Bounce',
|
||||
);
|
||||
|
||||
return $commands{ $command } if exists $commands{ $command };
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
40
lib/WebGUI/MailCommand/Bounce.pm
Normal file
40
lib/WebGUI/MailCommand/Bounce.pm
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
package WebGUI::MailCommand::Bounce;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::Mailing::Email;
|
||||
use Mail::DeliveryStatus::BounceParser;
|
||||
|
||||
use base 'WebGUI::MailCommand';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub process {
|
||||
my $self = shift;
|
||||
my $hexId = shift;
|
||||
my $session = $self->session;
|
||||
my $log = $session->log;
|
||||
my $id = $session->id->fromHex( $hexId );
|
||||
|
||||
my $email = WebGUI::Mailing::Email->new( $session, $id );
|
||||
|
||||
if ($email) {
|
||||
my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
|
||||
|
||||
my $report = ( $dsr->reports )[0];
|
||||
my $reason = $report->get( 'std_reason' );
|
||||
my $message = $report->get( 'reason' );
|
||||
$message =~ s{\s+}{ }g;
|
||||
|
||||
$log->warn( "Registering email [$id] as bounced." );
|
||||
$email->registerBounced( $reason, $message );
|
||||
}
|
||||
else {
|
||||
$log->error( "Cannot process bounced email [$id] because it cannot be located in the db." );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
28
lib/WebGUI/MailCommand/Subscribe.pm
Normal file
28
lib/WebGUI/MailCommand/Subscribe.pm
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
package WebGUI::MailCommand::Subscribe;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::AssetAspect::Subscriber;
|
||||
|
||||
use base 'WebGUI::MailCommand';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub process {
|
||||
my $self = shift;
|
||||
my $listName = shift;
|
||||
my $fromAddress = shift;
|
||||
my $session = $self->session;
|
||||
my $log = $session->log;
|
||||
|
||||
my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
|
||||
|
||||
die "Invalid list name [$listName]" unless $asset;
|
||||
|
||||
$asset->subscribeAnonymous( $fromAddress );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
27
lib/WebGUI/MailCommand/Unsubscribe.pm
Normal file
27
lib/WebGUI/MailCommand/Unsubscribe.pm
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
package WebGUI::MailCommand::Unsubscribe;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use WebGUI::AssetAspect::Subscriber;
|
||||
|
||||
use base 'WebGUI::MailCommand';
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub process {
|
||||
my $self = shift;
|
||||
my $listName = shift;
|
||||
my $fromAddress = shift;
|
||||
my $session = $self->session;
|
||||
|
||||
my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName );
|
||||
|
||||
die "Invalid list name [$listName]" unless $asset;
|
||||
|
||||
$asset->unsubscribeAnonymous( $fromAddress );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -12,7 +12,7 @@ use strict;
|
|||
use Pod::Usage;
|
||||
use Getopt::Long;
|
||||
use WebGUI::Session;
|
||||
use List::MoreUtils qw{ insert_after_string };
|
||||
use List::MoreUtils qw{ insert_after_string none };
|
||||
|
||||
# Get parameters here, including $help
|
||||
GetOptions(
|
||||
|
|
@ -32,10 +32,27 @@ addTemplateColumnToNewsletterCollection( $session );
|
|||
addRecentColumnToNewsletterCollection( $session );
|
||||
renamespaceTemplates( $session );
|
||||
addSpecialStateTable( $session );
|
||||
addListNameColumn( $session );
|
||||
addRegistrationSteps( $session );
|
||||
|
||||
finish($session);
|
||||
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub addListNameColumn {
|
||||
my $session = shift;
|
||||
my $db = $session->db;
|
||||
print "\tAdding list name column for subscribers...";
|
||||
|
||||
my @columns = $db->buildArray( 'desc assetAspectSubscriber' );
|
||||
|
||||
if ( none { $_ eq 'listName' } @columns ) {
|
||||
$db->write( 'alter table assetAspectSubscriber add column listName varchar(255)' );
|
||||
}
|
||||
|
||||
print "Done.\n";
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
sub installMailableAspectTable {
|
||||
my $session = shift;
|
||||
|
|
|
|||
|
|
@ -8,53 +8,97 @@ BEGIN {
|
|||
}
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.010;
|
||||
|
||||
use Mail::DeliveryStatus::BounceParser;
|
||||
use WebGUI::Mailing::Email;
|
||||
use WebGUI::MailCommand;
|
||||
use List::MoreUtils qw{ any };
|
||||
use WebGUI::Config;
|
||||
use Getopt::Long;
|
||||
use Readonly;
|
||||
|
||||
Readonly my $WRONG_USAGE => 64;
|
||||
Readonly my $DATA_ERROR => 65;
|
||||
Readonly my $NO_SUCH_USER => 67;
|
||||
Readonly my $UNKNOWN_HOST => 68;
|
||||
Readonly my $CONFIG_ERROR => 78;
|
||||
|
||||
my $NO_SUCH_USER = 67;
|
||||
my $webguiRoot = '/data/WebGUI';
|
||||
my %configs = (
|
||||
'lom.lom.st.unitedknowledge.org' => 'www.lomcongres.nl.conf',
|
||||
);
|
||||
|
||||
|
||||
#---------------------------------------------------------------
|
||||
my ( $domain, $user ) = @ARGV;
|
||||
my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
|
||||
# Startup
|
||||
{
|
||||
my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials();
|
||||
|
||||
my $configFile = $configs{ $domain };
|
||||
my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
|
||||
if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
|
||||
my $session = openSession( $webguiRoot, $configFile );
|
||||
no warnings 'once';
|
||||
*{ WebGUI::Session::Env::getIp } = sub {
|
||||
return $senderIp;
|
||||
};
|
||||
|
||||
unless ( $configFile && $validCommand ) {
|
||||
# system "/usr/sbin/sendmail -G -i $user\@$domain";
|
||||
exit(0);
|
||||
}
|
||||
else {
|
||||
my $session = WebGUI::Session->open($webguiRoot,$configFile);
|
||||
$session->log->warn( 'valid bounce address' );
|
||||
my $email = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) );
|
||||
|
||||
if ($email) {
|
||||
$session->log->warn( 'found email' );
|
||||
my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
|
||||
|
||||
my $report = ( $dsr->reports )[0];
|
||||
my $reason = $report->get( 'std_reason' );
|
||||
my $message = $report->get( 'reason' );
|
||||
$message =~ s{\s+}{ }g;
|
||||
$session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]");
|
||||
|
||||
$session->log->warn( 'about to register as bounced' );
|
||||
$email->registerBounced( $reason, $message );
|
||||
WebGUI::MailCommand::processCommand( $session, $command, $id, $sender );
|
||||
|
||||
closeSession( $session );
|
||||
}
|
||||
else {
|
||||
$session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
|
||||
warn "Not a valid command [$command].";
|
||||
exit( $NO_SUCH_USER );
|
||||
#die "Not a valid command [$command].";
|
||||
}
|
||||
|
||||
exit(0);
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub getCredentials {
|
||||
my ( $domain, $user, $sender, $senderIp );
|
||||
|
||||
GetOptions(
|
||||
'domain=s' => \$domain,
|
||||
'user=s' => \$user,
|
||||
'sender=s' => \$sender,
|
||||
'senderIp=s'=> \$senderIp,
|
||||
);
|
||||
warn "--domain parameter is required" && exit( $WRONG_USAGE ) unless $domain;
|
||||
warn "--user parameter is required" && exit( $WRONG_USAGE ) unless $user;
|
||||
warn "--sender parameter is required" && exit( $WRONG_USAGE ) unless $sender;
|
||||
warn "--senderIp parameter is required" && exit( $WRONG_USAGE ) unless $senderIp;
|
||||
|
||||
my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' )
|
||||
|| warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR );
|
||||
|
||||
my $configFile = $dispatch->get( $domain )
|
||||
|| warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST );
|
||||
|
||||
# Format is mailId-command
|
||||
my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix;
|
||||
|
||||
print "Received mail addressed to [$user\@$domain] which contains no id" && exit( $NO_SUCH_USER ) unless $id;
|
||||
print "Received mail addressed to [$user\@$domain] which contains no command" && exit( $NO_SUCH_USER ) unless $command;
|
||||
|
||||
return ( $configFile, $command, $id, $sender, $senderIp );
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub openSession {
|
||||
my $webguiRoot = shift;
|
||||
my $configFile = shift;
|
||||
|
||||
# Require WebGUI:Session rather than use it to save compilation of it when invalid commands are passed.
|
||||
require WebGUI::Session;
|
||||
|
||||
my $session = WebGUI::Session->open( $webguiRoot, $configFile );
|
||||
|
||||
return $session;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
sub closeSession {
|
||||
my $session = shift;
|
||||
|
||||
$session->close;
|
||||
exit (0);
|
||||
}
|
||||
|
||||
exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue