Commit 876795c6 authored by taggart's avatar taggart

initial version of script to find subscriptions in a domain that seem to be bad

parent c326fbce
#!/usr/bin/perl -w
# findoldbounce - for a given domain, list the subscribers that have been
# bouncing for a long time
# NOTE: this script requires the current user has read access to the db
# Matt Taggart <taggart@riseup.net> 2019-08
my $score=20;
# today minus 6 months
my $time=`date +%s` - 15768000;
my $code="5.1.1";
# things we might remove:
# if firstbounce is 6 months old and the bounce code is 5.1.1 and the bounce score is >15
my $listsql=q(mysql -N --batch --database=sympa --execute "select user_subscriber, bounce_subscriber from subscriber_table WHERE bounce_subscriber <> 'NULL'");
if ( ! $ARGV[0] ) {
print "usage: findoldbounce <domain>\n";
exit 1;
}
my $target = $ARGV[0];
print "$target\n";
open(LISTDUMP, "$listsql|") or die "cannot get dump of address+bounce pairs from database\n";
while (<LISTDUMP>) {
chomp;
# match sane address and list
m/^<?(.*\@(.*?))>?\s*\t(.*) (.*) (.*) (.*)$/;
my $address=$1;
my $domain=$2;
my $firstbounce=$3;
my $lastbounce=$4;
my $bouncescore=$5;
my $bouncecode=$6;
#print "$address $domain $firstbounce $lastbounce $bouncescore $bouncecode\n";
if ( $domain eq $target ) {
# hash, key is list, value is number of subscriber
#$domcount{$list}++;
if ( $firstbounce < $time && $bouncecode eq $code && $bouncescore > $score) {
print "$address $firstbounce $lastbounce $bouncescore $bouncecode\n";
}
}
}
# sort by number of lists subscribed
#foreach $list ( sort { $domcount{$b} <=> $domcount{$a} } keys %domcount) {
# $count++;
# print "$list ", $domcount{$list}, "\n";
# if ( $count == $limit ) {last;}
#}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment