UnitedKnowledge/webgui_newsletter
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactoring postfix transport script to allow pluggable commands.

Browse source
This commit is contained in:
Martin Kamerbeek 2010-10-13 10:31:52 +02:00
parent a735068f25
commit 37120bafa8
4 changed files with 184 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

53
lib/WebGUI/MailCommand.pm Normal file
View file

@ -0,0 +1,53 @@
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 $commandClass = resolveCommandClass( $command )
|| return;
my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] );
return $commandObject->process( $parameter );
}
sub session {
return (shift)->{ _session };
}
sub resolveCommandClass {
my $command = shift;
# TODO: Do not hard code.
my %commands = (
bounce => 'WebGUI::MailCommand::Bounce',
);
return $commands{ $command } if exists $commands{ $command };
return;
}
1;

40
lib/WebGUI/MailCommand/Bounce.pm Normal file
View 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;

27
lib/WebGUI/MailCommand/Subscribe.pm Normal file
View file

@ -0,0 +1,27 @@
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 $session = $self->session;
my $log = $session->log;
my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName );
die "Invalid list name [$listName]" unless $asset;
$asset->subscribeThroughEmail( $fromAddress );
return;
}
1;

93
sbin/newsletter-transport.pl
View file

@ -8,53 +8,82 @@ BEGIN {
}
use strict;
use warnings;
use Mail::DeliveryStatus::BounceParser;
use WebGUI::Mailing::Email;
#use Mail::DeliveryStatus::BounceParser;
#use WebGUI::Mailing::Email;
use WebGUI::MailCommand;
use List::MoreUtils qw{ any };
use WebGUI::Config;
use Getopt::Long;
use 5.010;
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 ) = 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 );
WebGUI::MailCommand::processCommand( $session, $command, $id );
closeSession( $session );
}
else {
# TODO: log something
}
unless ( $configFile && $validCommand ) {
# system "/usr/sbin/sendmail -G -i $user\@$domain";
exit(0);
}
else {
#-----------------------------------------------------------------------------
sub getCredentials {
my ( $domain, $user );
GetOptions(
'domain=s' => \$domain,
'user=s' => \$user,
);
die "--domain parameter is required" unless $domain;
die "--user paramere is required" unless $user;
my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' )
|| die "Cannot open $webguiRoot/etc/mailing_dispatch.config";
my $configFile = $dispatch->get( $domain )
|| die "Received mail for domain [$domain] which is not configured!";
# Format is mailId-command
my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix;
die "Received mail addressed to [$user\@$domain] which contains no id" unless $id;
die "Received mail addressed to [$user\@$domain] which contains no command" unless $command;
return ( $configFile, $command, $id );
}
#-----------------------------------------------------------------------------
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 );
$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( 'about to register as bounced' );
$email->registerBounced( $reason, $message );
}
else {
$session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
return $session;
}
#-----------------------------------------------------------------------------
sub closeSession {
my $session = shift;
$session->close;
exit (0);
}
exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };