[929] | 1 | #!/usr/bin/perl
|
---|
| 2 | # Bulk-delete records by pattern from a zone
|
---|
| 3 | ##
|
---|
| 4 | # Copyright 2025 Kris Deugau <kdeugau@deepnet.cx>
|
---|
| 5 | #
|
---|
| 6 | # This program is free software: you can redistribute it and/or modify
|
---|
| 7 | # it under the terms of the GNU General Public License as published by
|
---|
| 8 | # the Free Software Foundation, either version 3 of the License, or
|
---|
| 9 | # (at your option) any later version.
|
---|
| 10 | #
|
---|
| 11 | # This program is distributed in the hope that it will be useful,
|
---|
| 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 14 | # GNU General Public License for more details.
|
---|
| 15 | #
|
---|
| 16 | # You should have received a copy of the GNU General Public License
|
---|
| 17 | # along with this program. If not, see <http://www.gnu.org/licenses/>.
|
---|
| 18 | ##
|
---|
| 19 |
|
---|
| 20 | use strict;
|
---|
| 21 | use warnings;
|
---|
| 22 | use Getopt::Long;
|
---|
| 23 |
|
---|
| 24 | # Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
|
---|
| 25 | # See https://secure.deepnet.cx/trac/dnsadmin/ticket/80 for more gory details on how we got here.
|
---|
| 26 | use File::Spec ();
|
---|
| 27 | use File::Basename ();
|
---|
| 28 | my $path;
|
---|
| 29 | BEGIN {
|
---|
| 30 | $path = File::Basename::dirname(File::Spec->rel2abs($0));
|
---|
| 31 | if ($path =~ /(.*)/) {
|
---|
| 32 | $path = $1;
|
---|
| 33 | }
|
---|
| 34 | }
|
---|
| 35 | use lib $path;
|
---|
| 36 |
|
---|
| 37 | use DNSDB;
|
---|
| 38 |
|
---|
| 39 | my $dnsdb = new DNSDB;
|
---|
| 40 |
|
---|
| 41 | my $usage = "usage: bulkdel.pl [-v|--verbose] [-t|--dry-run|] zonename pattern [pattern]
|
---|
| 42 | [pattern] ....
|
---|
| 43 | Zone name and at least one pattern are required. Further arguments
|
---|
| 44 | are taken as additional patterns.
|
---|
| 45 | Patterns should be limited to valid DNS name fragments.
|
---|
| 46 | ";
|
---|
| 47 |
|
---|
| 48 | my $dryrun = 0;
|
---|
| 49 | my $verbose = 0;
|
---|
| 50 |
|
---|
| 51 | # -t came to mind for something else
|
---|
| 52 | GetOptions(
|
---|
| 53 | "dry-run" => \$dryrun,
|
---|
| 54 | "verbose" => \$verbose,
|
---|
| 55 | );
|
---|
| 56 |
|
---|
| 57 | die $usage if !$ARGV[1];
|
---|
| 58 | die $usage if $ARGV[0] !~ /^[\w._-]+$/;
|
---|
| 59 | # keep patterns simple
|
---|
| 60 | foreach (@ARGV) {
|
---|
| 61 | die $usage unless /^[\w._-]+$/;
|
---|
| 62 | }
|
---|
| 63 |
|
---|
| 64 | my $zname = shift @ARGV;
|
---|
| 65 |
|
---|
| 66 | my $zid;
|
---|
| 67 | my $revrec = 'n';
|
---|
| 68 | my $code;
|
---|
| 69 | my $cidr;
|
---|
| 70 |
|
---|
| 71 | if ($zname =~ /\.arpa\.?$/ || $zname =~ m{^[\d./]+$} || $zname =~ m{^[0-9a-f:/]+$}) {
|
---|
| 72 | # reverse zone
|
---|
| 73 | ($code, $cidr) = DNSDB::_zone2cidr($zname);
|
---|
| 74 | die "$zname not a valid reverse zone form: ".$dnsdb->errstr."\n" if $code ne 'OK';
|
---|
| 75 | $zid = $dnsdb->revID($cidr, '');
|
---|
| 76 | die "zone $zname not found\n" if !$zid;
|
---|
| 77 | $revrec = 'y';
|
---|
| 78 | } else {
|
---|
| 79 | $zid = $dnsdb->domainID($zname, '');
|
---|
| 80 | die "zone $zname not found\n" if !$zid;
|
---|
| 81 | }
|
---|
| 82 |
|
---|
| 83 | # get userdata for log
|
---|
| 84 | ($dnsdb->{logusername}, undef, undef, undef, undef, undef, $dnsdb->{logfullname}) = getpwuid($<);
|
---|
| 85 | $dnsdb->{logfullname} =~ s/,//g;
|
---|
| 86 | $dnsdb->{loguserid} = 0; # not worth setting up a pseudouser the way the RPC system does
|
---|
| 87 | $dnsdb->{logusername} = $dnsdb->{logusername}."/bulkdel.pl";
|
---|
| 88 | $dnsdb->{logfullname} = ($dnsdb->{logfullname} ? $dnsdb->{logfullname}."/bulkdel.pl" : $dnsdb->{logusername});
|
---|
| 89 |
|
---|
| 90 | $dnsdb->{dbh}->{AutoCommit} = 0;
|
---|
| 91 | $dnsdb->{dbh}->{RaiseError} = 1;
|
---|
| 92 |
|
---|
| 93 | eval {
|
---|
| 94 | my $logpar;
|
---|
| 95 | if ($revrec eq 'n') {
|
---|
| 96 | $logpar = $dnsdb->_log(group_id => $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec), domain_id => $zid,
|
---|
| 97 | entry => "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']");
|
---|
| 98 | } else {
|
---|
| 99 | $logpar = $dnsdb->_log(group_id => $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec), rdns_id => $zid,
|
---|
| 100 | entry => "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']");
|
---|
| 101 | }
|
---|
| 102 | print "Bulk-deleting records in $zname matching one of ['".join("','", @ARGV)."']\n" if $verbose;
|
---|
| 103 | my $sth = $dnsdb->{dbh}->prepare("DELETE FROM records WHERE ".
|
---|
| 104 | ($revrec eq 'n' ? 'domain_id' : 'rdns_id')." = ? AND (host ~* ? OR val ~* ?) ".
|
---|
| 105 | "RETURNING host, type, val, distance, weight, port, ttl, location"
|
---|
| 106 | );
|
---|
| 107 | # These bits of log data won't change through the run; we're only doing one zone at a time.
|
---|
| 108 | ##fixme ... unless a record is multizone (A+PTR et al)
|
---|
| 109 | my %logdata = (logparent => $logpar);
|
---|
| 110 | if ($revrec eq 'n') {
|
---|
| 111 | $logdata{domain_id} = $zid;
|
---|
| 112 | } else {
|
---|
| 113 | $logdata{rdns_id} = $zid;
|
---|
| 114 | }
|
---|
| 115 | foreach my $patt (@ARGV) {
|
---|
| 116 | $sth->execute($zid, $patt, $patt);
|
---|
| 117 | while (my ($host, $type, $val, $distance, $weight, $port, $ttl, $loc) = $sth->fetchrow_array) {
|
---|
| 118 | $logdata{group_id} = $dnsdb->parentID(id => $zid, type => 'domain', revrec => $revrec);
|
---|
| 119 | $logdata{entry} = "[bulkdel.pl $zname $patt] Removed '$host $typemap{$type} $val";
|
---|
| 120 | $logdata{entry} .= " [distance $distance]" if $typemap{$type} eq 'MX';
|
---|
| 121 | $logdata{entry} .= " [priority $distance] [weight $weight] [port $port]" if $typemap{$type} eq 'SRV';
|
---|
| 122 | $logdata{entry} .= "', TTL $ttl";
|
---|
| 123 | $logdata{entry} .= ", location ".$dnsdb->getLoc($loc)->{description} if $loc;
|
---|
| 124 | print "$logdata{entry}\n" if $verbose;
|
---|
| 125 | $dnsdb->_log(%logdata)
|
---|
| 126 | }
|
---|
| 127 | }
|
---|
| 128 | $dnsdb->_updateserial(%logdata);
|
---|
| 129 | if ($dryrun) {
|
---|
| 130 | $dnsdb->{dbh}->rollback;
|
---|
| 131 | } else {
|
---|
| 132 | $dnsdb->{dbh}->commit;
|
---|
| 133 | }
|
---|
| 134 | };
|
---|
| 135 | if ($@) {
|
---|
| 136 | die "error bulk-deleting records: $@\n";
|
---|
| 137 | }
|
---|