Changeset 1048 for branches/stable


Ignore:
Timestamp:
02/27/26 18:02:02 (4 hours ago)
Author:
Kris Deugau
Message:

/branches/stable

Rollup merge of changes to auxiliary scripts

Location:
branches/stable
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • branches/stable

  • branches/stable/DNSDB.pm

    r1047 r1048  
    19551955
    19561956    if ($cn) {
    1957       # "natural n'th IP in the block" pattern
    1958       $$tmpl =~ s/$cn/$ipindex+1/e;
     1957      # "n'th natural IP in the block" pattern.
     1958      my $iptmp = new NetAddr::IP $ip;
     1959      my $natdex = scalar($iptmp - $$subnet);
     1960      $natdex++;
     1961      $$tmpl =~ s/$cn/$natdex/;
    19591962    }
    19601963

  • branches/stable/compact-recs.pl

    r1047 r1048  
    44##
    55# $Id$
    6 # Copyright 2013,2014,2018,2020 Kris Deugau <kdeugau@deepnet.cx>
     6# Copyright 2013-2022,2025 Kris Deugau <kdeugau@deepnet.cx>
    77#
    88#    This program is free software: you can redistribute it and/or modify
    … …  
    2222use strict;
    2323use warnings;
    24 
    25 # push "the directory the script is in" into @INC
    26 use FindBin;
    27 use lib "$FindBin::RealBin/";
     24use Getopt::Long;
     25
     26# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
     27# See https://secure.deepnet.cx/trac/dnsadmin/ticket/80 for more gory details on how we got here.
     28use File::Spec ();
     29use File::Basename ();
     30my $path;
     31BEGIN {
     32    $path = File::Basename::dirname(File::Spec->rel2abs($0));
     33    if ($path =~ /(.*)/) {
     34        $path = $1;
     35    }
     36}
     37use lib $path;
    2838
    2939use DNSDB;
    … …  
    3242
    3343sub usage {
    34   die qq(usage:  compact-recs.pl netblock pattern
    35     netblock  the CIDR block to define the A+PTR template on
    36     pattern   the pattern to define the new A+PTR template with, and
    37               to match A+PTR records within the netblock for deletion
     44  die qq(usage:  compact-recs.pl netblock pattern [--replace [record id]]
     45    netblock   the CIDR block to define the A+PTR template on
     46    pattern    the pattern to define the new A+PTR template with, and
     47               to match A+PTR records within the netblock for deletion
     48    --replace  Optional argument to update an existing template if found.
     49               A record ID can be specified to match a particular record,
     50               or 'all' to forcibly remove all but one in the event of
     51               multiple records.  If multiple records are found but neither
     52               'all' or a specific record ID is specified, an error will be
     53               returned and nothing will be changed since there is no
     54               guarantee of which record might be replaced.
     55
    3856        OR
    3957        compact-recs.pl --batch patternfile
    4058    patternfile should be a file containing a list of netblock-pattern
    41     pairs, whitespace separated
     59    pairs, whitespace separated.  --replace is ignored in this mode.
    4260
    4361    A PTR template record will be created instead of an A+PTR template
    … …  
    4563    the database.
    4664
    47     WARNING:  Multiple runs will result in duplicate template records.
     65    WARNING:  Multiple runs may result in duplicate template records.
    4866);
     67}
     68
     69my $batchmode = 0;
     70my $replace = 0;
     71my $tmpl_msg = '';
     72
     73GetOptions("batch" => \$batchmode,
     74        "replace:s" => \&setreplace );
     75
     76sub setreplace {
     77  if ($_[1] eq '') {
     78    $replace = -1;
     79  } else {
     80    $replace = $_[1];
     81  }
     82}
     83
     84if ($replace && $replace !~ /^(all|-?\d+)$/) {
     85  warn "Invalid --replace argument $replace:\n";
     86  usage();
    4987}
    5088
    … …  
    5997$dnsdb->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does
    6098$dnsdb->{logusername} = $dnsdb->{logusername}."/compact-recs.pl";
    61 $dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};
    62 
    63 if ($ARGV[0] eq '--batch') {
    64   open NBLIST, "<$ARGV[1]";
     99$dnsdb->{logfullname} = ($dnsdb->{logfullname} ? $dnsdb->{logfullname}."/compact-recs.pl" : $dnsdb->{logusername});
     100
     101if ($batchmode) {
     102  # --replace not safe for --batch.  could arguably support an in-file flag someday?
     103  if ($replace) {
     104    $replace = 0;
     105    warn "--replace not compatible with --batch.  Attempting to continue.\n";
     106  }
     107  open NBLIST, "<$ARGV[0]";
    65108  while (<NBLIST>) {
    66109    next if /^#/;
    … …  
    85128  $dbh->{RaiseError} = 1;
    86129
    87   my ($zone,$ploc) = $dbh->selectrow_array("SELECT rdns_id,default_location FROM revzones WHERE revnet >>= ?",
    88         undef, ($cidr) );
     130  my ($zonecidr,$zone,$ploc) = $dbh->selectrow_array(
     131      "SELECT revnet,rdns_id,default_location FROM revzones WHERE revnet >>= ?",
     132      undef, ($cidr) );
    89133  if (!$zone) {
    90134    warn "$cidr is not within a zone currently managed here.\n";
    … …  
    93137  my $soa = $dnsdb->getSOA('n', 'y', $zone);
    94138  my $dparent = $dnsdb->_hostparent($patt) || 0;
     139  # Automatically choose new type as A+PTR template if the new pattern's
     140  # domain is managed in this instance, or PTR template if not
    95141  my $newtype = ($dparent ? 65283 : 65282);
    96142
    97   my ($istmpl) = $dbh->selectrow_array("SELECT count(*) FROM records WHERE rdns_id = ? AND ".
    98         "(type=65282 OR type=65283) AND val = ?", undef, ($zone, $cidr) );
    99   if ($istmpl) {
    100     print "Template already exists for $cidr, manual cleanup required\n";
     143  my ($tmplcount) = $dbh->selectrow_array("SELECT count(*) FROM records WHERE rdns_id = ? AND ".
     144      "(type=65282 OR type=65283) AND val = ?", undef, ($zone, $cidr) );
     145  if ($tmplcount && !$replace) {
     146    # Template(s) found, --replace not set
     147    print "One or more templates found for $cidr, use --replace [record_id],".
     148        " --replace all, or clean up manually.\n";
     149    return;
     150  } elsif ($tmplcount > 1 && ($replace eq '0' || $replace eq '-1')) {
     151    # Multiple templates found, --replace either not set (==0) or no argument provided (==-1)
     152    print "Multiple templates found matching $cidr but no record ID specified with".
     153        " --replace.  Use --replace with a record ID, use --replace all, or clean up".
     154        " manually.\n";
    101155    return;
    102156  }
    … …  
    106160
    107161  eval {
     162    # First, clean up the records that match the template.
    108163    my $getsth = $dbh->prepare("SELECT record_id,host,val FROM records ".
    109         "WHERE (type = 12 OR type > 65000) AND inetlazy(val) << ?");
     164        "WHERE (type = 12 OR type > 65000) AND inetlazy(val) << ? AND rdns_id = ?");
    110165    my $delsth = $dbh->prepare("DELETE FROM records WHERE record_id = ?");
    111     $getsth->execute($cidr);
     166    $getsth->execute($cidr, $zone);
    112167    my $i = 0;
    113168    while (my ($id,$host,$val) = $getsth->fetchrow_array) {
    114169      my $cmp = $patt;
    115       DNSDB::_template4_expand(\$cmp, $val);
     170      # skip existing template within the new template's range
     171      next if $val =~ m{/\d+$};
     172      if ($cmp =~ /\%-?c/) {
     173        # Determine "nth host" index value of $val for %c and %-c
     174        my $possible = new NetAddr::IP $val;
     175        my $valindex = $possible - $cidr;
     176        DNSDB::_template4_expand(\$cmp, $val, \$cidr, $valindex);
     177      } else {
     178        DNSDB::_template4_expand(\$cmp, $val, \$cidr);
     179      }
    116180      $delsth->execute($id) if $cmp eq $host;
    117181      $delcnt++ if $cmp eq $host;
    118 #      print "got $id, '$host', '$val';  compare '$cmp'\t";
    119 #      print "  delete\n" if $cmp eq $host;
    120 #      print "  keep\n"  if $cmp ne $host;
    121 #      last if $i++ >8;
    122     }
    123 
    124     $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
     182    }
     183
     184    my $template_modified = 0;
     185
     186    if ($replace) {
     187      if ($replace eq 'all') {
     188        # clear any templates with the same CIDR, and add a new one
     189        $dbh->do("DELETE from records WHERE rdns_id = ? AND (type=65282 OR type=65283) AND val = ?", undef, ($zone, $cidr) );
     190        $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
     191            undef, ($dparent, $zone, $patt, $newtype, $cidr, $soa->{minttl}, $ploc) );
     192        $template_modified = 1;
     193        $tmpl_msg = ", replaced $tmplcount template records";
     194      } else {
     195        if ($replace =~ /^\d+$/) {
     196          # $replace == [id] -> replace that record ID, error if it doesn't exist or isn't
     197          # a template for the specified CIDR.  Arguably some stretch on the latter.
     198          my ($rechost,$recval,$rectype) = $dbh->selectrow_array(
     199              "SELECT host,val,type,record_id FROM records WHERE record_id = ?",
     200              undef, $replace);
     201          if (($rectype == 65282 || $rectype == 65283) && $recval eq $cidr) {
     202            # Do the update if the record specified matches is a suitable template
     203            $dbh->do("UPDATE records SET host = ?, type = ?, val = ? WHERE record_id = ?",
     204                undef, ($patt, $newtype, $cidr, $replace) );
     205            $template_modified = 1;
     206            $tmpl_msg = ", replaced an existing template record";
     207          } else {
     208            # Specified record ID isn't a template record, or doesn't match $cidr, or both
     209            die "Specified record ID isn't a template for $cidr, skipping:\n".
     210                "  $replace found:  $rechost $typemap{$rectype} $recval\n";
     211          }
     212        } else {
     213          # $replace == -1 -> replace/update template iff one template is present
     214          #   (should have errored out earlier if multiple templates are present)
     215          my ($rechost,$recval,$rectype,$recid) = $dbh->selectrow_array(
     216              "SELECT host,val,type,record_id FROM records WHERE rdns_id = ? AND (type=65282 OR type=65283) AND val = ?",
     217              undef, ($zone, $cidr) );
     218          if ($recid) {
     219            # Do the update if we've found an existing template with the same CIDR
     220            $dbh->do("UPDATE records SET host = ?, type = ?, val = ? WHERE record_id = ?",
     221                undef, ($patt, $newtype, $cidr, $recid) );
     222            $template_modified = 1;
     223            $tmpl_msg = ", replaced an existing template record";
     224          } else {
     225            $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
     226                undef, ($dparent, $zone, $patt, $newtype, $cidr, $soa->{minttl}, $ploc) );
     227            $template_modified = 1;
     228          }
     229        } # $replace -> [id] or $replace == -1
     230      } # $replace <> 'all'
     231    } else {
     232      # $replace == 0 (not set), just insert the new template
     233      $dbh->do("INSERT INTO records (domain_id, rdns_id, host, type, val, ttl, location) VALUES (?,?,?,?,?,?,?)",
    125234        undef, ($dparent, $zone, $patt, $newtype, $cidr, $soa->{minttl}, $ploc) );
    126     $dbh->do("UPDATE revzones SET changed='y' WHERE rdns_id = ?", undef, ($zone));
    127     $dbh->do("UPDATE domains SET changed='y' WHERE domain_id = ?", undef, ($dparent)) if $dparent;
    128     $dnsdb->_log(rdns_id => $zone, domain_id => $dparent, group_id => 1,
    129         entry => "A+PTR and/or PTR records in $cidr matching $patt replaced by $typemap{$newtype} record for $cidr");
    130 
    131 #    $dbh->rollback;
    132     $dbh->commit;
     235      $template_modified = 1;
     236    }
     237
     238    if ($template_modified) {
     239      my %logdata = (rdns_id => $zone, domain_id => $dparent, group_id => 1,
     240          entry => "A+PTR and/or PTR records in $cidr matching $patt replaced by $typemap{$newtype} record for $cidr");
     241      $dnsdb->_updateserial(%logdata);
     242      $dnsdb->_log(%logdata);
     243      $dbh->commit;
     244    } else {
     245      # no need to do push out a null update that just bumps the serial on the zone(s)
     246      $dbh->rollback;
     247    }
     248
    133249  };
    134250  if ($@) {
    135     print "barf: $@\n";
     251    print "Error(s) encountered: $@\n";
    136252    $dbh->rollback;
    137253    return;
    138254  }
    139   print " complete ($delcnt records)\n";
     255  print " complete (removed $delcnt PTR/A+PTR records";
     256  print $tmpl_msg;
     257  print ")\n";
    140258} # squashem ()

  • branches/stable/dns.cgi

    r1047 r1048  
    33##
    44# $Id$
    5 # Copyright 2008-2020 Kris Deugau <kdeugau@deepnet.cx>
     5# Copyright 2008-2022 Kris Deugau <kdeugau@deepnet.cx>
    66#
    77#    This program is free software: you can redistribute it and/or modify

  • branches/stable/mergerecs

    r1047 r1048  
    33##
    44# $Id$
    5 # Copyright 2014,2016,2018,2020 Kris Deugau <kdeugau@deepnet.cx>
     5# Copyright 2014-2022 Kris Deugau <kdeugau@deepnet.cx>
    66#
    77#    This program is free software: you can redistribute it and/or modify
    … …  
    2727use Data::Dumper;
    2828
    29 # push "the directory the script is in" into @INC
    30 use FindBin;
    31 use lib "$FindBin::RealBin/";
     29# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
     30# See https://secure.deepnet.cx/trac/dnsadmin/ticket/80 for more gory details on how we got here.
     31use File::Spec ();
     32use File::Basename ();
     33my $path;
     34BEGIN {
     35    $path = File::Basename::dirname(File::Spec->rel2abs($0));
     36    if ($path =~ /(.*)/) {
     37        $path = $1;
     38    }
     39}
     40use lib $path;
    3241
    3342use DNSDB;
    … …  
    6776$dnsdb->{loguserid} = 0;        # not worth setting up a pseudouser the way the RPC system does
    6877$dnsdb->{logusername} = $dnsdb->{logusername}."/mergerecs";
    69 $dnsdb->{logfullname} = $dnsdb->{logusername} if !$dnsdb->{logfullname};
     78$dnsdb->{logfullname} = ($dnsdb->{logfullname} ? $dnsdb->{logfullname}."/mergerecs" : $dnsdb->{logusername});
    7079
    7180# and now the meat
    … …  
    8695  }
    8796  die "$pzone is not a valid reverse zone specification\n" if !$npzone;
    88   $zid = $dnsdb->revID($npzone, '');
     97  $zid = $dnsdb->revID($npzone, ':ANY:');
    8998} else {
    9099  $rev = 'n';
    91   $zid = $dnsdb->domainID($pzone, '');
     100  $zid = $dnsdb->domainID($pzone, ':ANY:');
    92101}
    93102die "$pzone is not a zone in the database (".$dnsdb->errstr.")\n" if !$zid;

  • branches/stable/textrecs.cgi

    r1047 r1048  
    33##
    44# $Id$
    5 # Copyright 2012-2014,2020 Kris Deugau <kdeugau@deepnet.cx>
     5# Copyright 2012-2014,2020,2022 Kris Deugau <kdeugau@deepnet.cx>
    66#
    77#    This program is free software: you can redistribute it and/or modify
    … …  
    2828use DBI;
    2929
    30 # push "the directory the script is in" into @INC
    31 use FindBin;
    32 use lib "$FindBin::RealBin/";
     30# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
     31use File::Spec ();
     32use File::Basename ();
     33my $path;
     34BEGIN {
     35    $path = File::Basename::dirname(File::Spec->rel2abs($0));
     36    if ($path =~ /(.*)/) {
     37        $path = $1;
     38    }
     39}
     40use lib $path;
    3341
    3442use DNSDB;

  • branches/stable/tiny-import.pl

    r1047 r1048  
    33##
    44# $Id$
    5 # Copyright 2012-2014,2020 Kris Deugau <kdeugau@deepnet.cx>
     5# Copyright 2012-2014,2020-2022 Kris Deugau <kdeugau@deepnet.cx>
    66#
    77#    This program is free software: you can redistribute it and/or modify
    … …  
    2828use Time::TAI64 qw(:tai);
    2929
    30 # push "the directory the script is in" into @INC
    31 use FindBin;
    32 use lib "$FindBin::RealBin/";
     30# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
     31use File::Spec ();
     32use File::Basename ();
     33my $path;
     34BEGIN {
     35    $path = File::Basename::dirname(File::Spec->rel2abs($0));
     36    if ($path =~ /(.*)/) {
     37        $path = $1;
     38    }
     39}
     40use lib $path;
    3341
    3442use DNSDB;
    … …  
    200208    chomp;
    201209    s/\s*$//;
     210    s/:+$//;
    202211    my $recstat = recslurp($_, $filecnt);
    203212    $ok++ if $recstat;
    … …  
    405414      $host =~ s/\.$//;
    406415      $host =~ s/^\\052/*/;
    407       $ttl = -1 if $ttl eq '';
     416      $ttl = -1 if !defined($ttl) || $ttl eq '';
    408417      $stamp = '' if !$stamp;
    409418      $loc = '' if !$loc;
    … …  
    542551      $host =~ s/\.$//;
    543552      $host =~ s/^\\052/*/;
    544       $ttl = -1 if $ttl eq '';
     553      $ttl = -1 if !defined($ttl) || $ttl eq '';
    545554      $stamp = '' if !$stamp;
    546555      $loc = '' if !$loc;
    … …  
    605614      if ($zone =~ /\.arpa$/) {
    606615        ($code,$msg) = DNSDB::_zone2cidr($zone);
    607         $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
     616        $dbh->do("INSERT INTO revzones (revnet,group_id,status,default_location,sertype,zserial) VALUES (?,?,1,?,'U',?)",
    608617                undef, ($msg, $importcfg{group}, $loc, $serial));
    609618        my ($rdns) = $dbh->selectrow_array("SELECT currval('revzones_rdns_id_seq')");
    … …  
    614623                $loc, $stamp, $expires, $stampactive);
    615624      } else {
    616         $dbh->do("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,1,?,?)",
     625        $dbh->do("INSERT INTO domains (domain,group_id,status,default_location,sertype,zserial) VALUES (?,?,1,?,'U',?)",
    617626                undef, ($zone, $importcfg{group}, $loc, $serial));
    618627        my ($domid) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')");
Note: See TracChangeset for help on using the changeset viewer.