Better bounce logging
This commit is contained in:
parent
b7b1811387
commit
55934b11f5
2 changed files with 37 additions and 43 deletions
|
|
@ -46,6 +46,9 @@ sub crud_definition {
|
||||||
sentTo => {
|
sentTo => {
|
||||||
fieldType => 'text',
|
fieldType => 'text',
|
||||||
},
|
},
|
||||||
|
bounceReason => {
|
||||||
|
fieldType => 'text',
|
||||||
|
},
|
||||||
);
|
);
|
||||||
|
|
||||||
$definition->{ properties } = {
|
$definition->{ properties } = {
|
||||||
|
|
@ -203,10 +206,13 @@ 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
|
||||||
|
|
|
||||||
|
|
@ -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 %configs = (
|
|
||||||
'martintwee.oqapi.nl' => 'martintwee.oqapi.nl.conf',
|
|
||||||
);
|
|
||||||
|
|
||||||
my $webguiRoot = '/data/WebGUI';
|
|
||||||
|
|
||||||
|
|
||||||
|
#---------------------------------------------------------------
|
||||||
my ( $domain, $user ) = @ARGV;
|
my ( $domain, $user ) = @ARGV;
|
||||||
|
my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i;
|
||||||
|
|
||||||
my $configFile = $configs{ $domain };
|
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 };
|
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 };
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue