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

Better bounce logging

Browse source
This commit is contained in:
Martin Kamerbeek 2010-05-20 15:22:23 +02:00
parent b7b1811387
commit 55934b11f5
2 changed files with 37 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

12
lib/WebGUI/Mailing/Email.pm
View file

@ -46,6 +46,9 @@ sub crud_definition {
sentTo => { sentTo => {
fieldType => 'text', fieldType => 'text',
}, },
bounceReason => {
fieldType => 'text',
},
); );
$definition->{ properties } = { $definition->{ properties } = {
@ -202,11 +205,14 @@ sub user {
} }
sub registerBounced { sub registerBounced {
my $self = shift; my $self = shift;
my $reason = shift;
my $message = shift;
$self->update( { $self->update( {
status => 'error', status => 'bounced',
errorMessage => 'Message was bounced', errorMessage => $message,
bounceReason => $reason,
} ); } );
#### TODO: Write to bounce log #### TODO: Write to bounce log

68
sbin/newsletter-transport.pl
View file

@ -2,6 +2,16 @@
use strict; use strict;
use Mail::DeliveryStatus::BounceParser;
use WebGUI::Mailing::Email;
use List::MoreUtils qw{ any };
my $NO_SUCH_USER = 67;
my $webguiRoot = '/data/WebGUI';
my %configs = (
'martintwee.oqapi.nl' => 'martintwee.oqapi.nl.conf',
);
BEGIN { BEGIN {
unshift @INC, qw( unshift @INC, qw(
/data/custom/webgui_newsletter/lib /data/custom/webgui_newsletter/lib
@ -9,61 +19,39 @@ BEGIN {
); );
} }
use WebGUI::Mailing::Email;
use List::MoreUtils qw{ any };
my $NO_SUCH_USER = 67; #---------------------------------------------------------------
my ( $domain, $user ) = @ARGV;
my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
my %configs = ( my $configFile = $configs{ $domain };
'martintwee.oqapi.nl' => 'martintwee.oqapi.nl.conf', my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
);
my $webguiRoot = '/data/WebGUI';
my ( $domain, $user ) = @ARGV;
my $configFile = $configs{ $domain };
my ( $listname, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
open my $log, '>>/data/test.log' || die "Cannot open log";
my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
print $log "[$command][$validCommand][$configFile]\n";
unless ( $configFile && $validCommand ) { unless ( $configFile && $validCommand ) {
print $log "Ignoring $domain $user\n"; # system "/usr/sbin/sendmail -G -i $user\@$domain";
close $log;
system "/usr/sbin/sendmail -G -i $user\@$domain";
exit(0); exit(0);
} }
else { else {
my $session = WebGUI::Session->open($webguiRoot,$configFile); my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $email = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $listname ) ); my $email = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) );
if ($email) { if ($email) {
print $log "Found email instance\n"; my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
$email->registerBounced;
my $report = ( $dsr->reports )[0];
my $reason = $report->get( 'std_reason' );
my $message = $report->get( 'reason' );
$message =~ s{\s+}{ }g;
$email->registerBounced( $reason, $message );
} }
else { else {
print $log "Can't find email instance\n"; $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
} }
$session->close; $session->close;
exit (0);
} }
local $/;
my $content = <STDIN>;
print $log "listname: $listname, command: $command\n";
#print $log "content: $content\n";
print $log "\n\n\n\n ================================================================================\n\n\n\n";
close $log;
exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm }; exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };