remove deliveries to purged domain.

removePurgedDelivery.pl

#!/usr/bin/perl
use strict;
use warnings;
use JSON::XS;
use Data::Dump qw(dump);
use DBI;
use Redis;

my $r = `docker inspect -f '{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}' mastodon1_db_backend_1`;
$r =~ /(\S+)/ or die "can't find db address. $r\n";
my $dbAddr = $1;
my $dbPort = XXXX;
my $dbName = 'XXXdbName';
my $dbUser = 'XXXdbUser';
my $dbPassword = 'XXXdbPassword';

$r = `docker inspect -f '{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}' mastodon1_redis_1`;
$r =~ /(\S+)/ or die "can't find redis address. $r\n";
my $redisAddr = $1;
my $redisPort = XXXX;

#############################################################################

my $dbh = DBI->connect(
    "dbi:Pg:dbname=$dbName;host=$dbAddr;port=$dbPort",
    $dbUser,
    $dbPassword
) or die $DBI::errstr;

my %cache;
sub isPurged{
    my($host)=@_;
    my $cache = $cache{$host};
    defined($cache) and return $cache;

    my($id) = $dbh->selectrow_array('select id from accounts where domain=? and suspended_at is null limit 1',{},$host);
    my $purged = (not defined $id) ? 1 : 0;
    $cache{$host}=$purged;
    return $purged;
}

my $redis = Redis->new(server => "$redisAddr:$redisPort")
    or die "can't connect to redis server $redisAddr:$redisPort .";

my $setKey = 'retry';

my $a = $redis->zrange($setKey, 0,-1);
for my $member(@$a){
    my $data = decode_json $member;
    my $class = ($data->{class} // "");
    if( $class eq "ActivityPub::DeliveryWorker"){
        next unless ($data->{error_message} // "") =~ m|https://([^?#/\s]+)|;
        my $host = $1;
        next unless isPurged($host);
        print "delete delivery to $host …\n";
        next if $redis->zrem($setKey,$member);
        print "zrem failed. member=$member\n";
    }
}