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 a5bef12584
commit a0f3443436
4 changed files with 184 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

99
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 };
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 );
if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
my $session = openSession( $webguiRoot, $configFile );
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 );
WebGUI::MailCommand::processCommand( $session, $command, $id );
closeSession( $session );
}
else {
$session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
# TODO: log something
}
exit(0);
}
#-----------------------------------------------------------------------------
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 );
return $session;
}
#-----------------------------------------------------------------------------
sub closeSession {
my $session = shift;
$session->close;
exit (0);
}
exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };
}