source: trunk/bulkdel.pl

#!/usr/bin/perl
# Bulk-delete records by pattern from a zone
##
# Copyright 2025 Kris Deugau <kdeugau@deepnet.cx>
# 
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version. 
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
##

use strict;
use warnings;
use Getopt::Long;

# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
# See https://secure.deepnet.cx/trac/dnsadmin/ticket/80 for more gory details on how we got here.
use File::Spec ();
use File::Basename ();
my $path;
BEGIN {
    $path = File::Basename::dirname(File::Spec->rel2abs($0));
    if ($path =~ /(.*)/) {
        $path = $1;
    }
}
use lib $path;

use DNSDB;

my $dnsdb = new DNSDB;

my $usage = "usage: bulkdel.pl [-v|--verbose] [-t|--dry-run|] zonename pattern [pattern]
        [pattern] ....
        Zone name and at least one pattern are required.  Further arguments
        are taken as additional patterns.
        Patterns should be limited to valid DNS name fragments.
";

my $dryrun = 0;
my $verbose = 0;

# -t came to mind for something else
GetOptions(
        "dry-run" => \$dryrun,
        "verbose" => \$verbose,
);

die $usage if !$ARGV[1];
die $usage if $ARGV[0] !~ /^[\w._-]+$/;
# keep patterns simple
foreach (@ARGV) {
  die $usage unless /^[\w._-]+$/;
}

my $zname = shift @ARGV;

my $zid;
my $revrec = 'n';
my $code;
my $cidr;

if ($zname =~ /\.arpa\.?$/ || $zname =~ m{^[\d./]+$} || $zname =~ m{^[0-9a-f:/]+$}) {
  # reverse zone
  ($code, $cidr) = DNSDB::_zone2cidr($zname);
  die "$zname not a valid reverse zone form: ".$dnsdb->errstr."\n" if $code ne 'OK';
  $zid = $dnsdb->revID($cidr, '');
  die "zone $zname not found\n" if !$zid;
  $revrec = 'y';
} else {
  $zid = $dnsdb->domainID($zname, '');
  die "zone $zname not found\n" if !$zid;
}

# get userdata for log
($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
$dnsdb->{logfullname} =~ s/,//g;
$dnsdb->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does
$dnsdb->{logusername} = $dnsdb->{logusername}."/bulkdel.pl";
$dnsdb->{logfullname} = ($dnsdb->{logfullname} ? $dnsdb->{logfullname}."/bulkdel.pl" : $dnsdb->{logusername});

$dnsdb->{dbh}->{AutoCommit} = 0;
$dnsdb->{dbh}->{RaiseError} = 1;

eval {
  my $logpar;
  if ($revrec eq 'n') {
    $logpar = $dnsdb->_log(group_id => $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec), domain_id => $zid,
        entry => "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']");
  } else {
    $logpar = $dnsdb->_log(group_id => $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec), rdns_id => $zid,
        entry => "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']");
  }
  print "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']\n" if $verbose;
  my $sth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE ".
        ($revrec eq 'n' ? 'domain_id' : 'rdns_id')." = ? AND (host ~* ? OR val ~* ?) ".
        "RETURNING host, type, val, distance, weight, port, ttl, location"
        );
  # These bits of log data won't change through the run;  we're only doing one zone at a time.
##fixme ... unless a record is multizone (A+PTR et al)
  my %logdata = (logparent => $logpar);
  if ($revrec eq 'n') {
    $logdata{domain_id} = $zid;
  } else {
    $logdata{rdns_id} = $zid;
  }
  foreach my $patt (@ARGV) {
    $sth->execute($zid, $patt, $patt);
    while (my ($host, $type, $val, $distance, $weight, $port, $ttl, $loc) = $sth->fetchrow_array) {
      $logdata{group_id} = $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec);
      $logdata{entry} = "[bulkdel.pl $zname $patt] Removed '$host $typemap{$type} $val";
      $logdata{entry} .= " [distance $distance]" if $typemap{$type} eq 'MX';
      $logdata{entry} .= " [priority $distance] [weight $weight] [port $port]" if $typemap{$type} eq 'SRV';
      $logdata{entry} .= "', TTL $ttl";
      $logdata{entry} .= ", location ".$dnsdb->getLoc($loc)->{description} if $loc;
      print "$logdata{entry}\n" if $verbose;
      $dnsdb->_log(%logdata)
    }
  }
  $dnsdb->_updateserial(%logdata);
  if ($dryrun) {
    $dnsdb->{dbh}->rollback;
  } else {
    $dnsdb->{dbh}->commit;
  }
};
if ($@) {
  die "error bulk-deleting records: $@\n";
}