Better bounce logging

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

View file

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

View file

@ -2,6 +2,16 @@
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 {
unshift @INC, qw(
/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 %configs = (
'martintwee.oqapi.nl' => 'martintwee.oqapi.nl.conf',
);
my $webguiRoot = '/data/WebGUI';
#---------------------------------------------------------------
my ( $domain, $user ) = @ARGV;
my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
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 ) {
print $log "Ignoring $domain $user\n";
close $log;
system "/usr/sbin/sendmail -G -i $user\@$domain";
# system "/usr/sbin/sendmail -G -i $user\@$domain";
exit(0);
}
else {
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) {
print $log "Found email instance\n";
$email->registerBounced;
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;
$email->registerBounced( $reason, $message );
}
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;
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 };