#!/usr/bin/env perl

# written by Joey Kelly
# 2025

use strict;
use warnings;

use feature 'say';

use Digest::MD5 qw(md5_hex);
use DNS::ZoneParse;
use Text::Diff;
use Data::Dumper;

$Data::Dumper::Indent = 1;

# NOTE: our chosen module (DNS::ZoneParse) exposes methods for:
# soa(), a(), cname(), srv(), mx(), ns(), ptr(), txt(), hinfo(), rp(), loc()
# I purposely have ignored hinfo(), rp(), loc()
# Internally, there is a lot of non-exposed code for other record types,
# but I don't want to muck around with the internals.
#
# Additionally, I discard DNSSEC and other records my use case doesn't cover:
# my $dig =  "dig \@$server -t AXFR +nottlid $domain | grep -Evi 'rrsig|dnskey|nsec|caa|^\$|^;'";


# we want to compare zone transfers from these two servers
my $server1 = 'roost.flockbox.net';
my $server2 = 'sustain.joeykelly.net';
my @serverlist = ($server1, $server2);


my @domainlist = qw(joeykelly.net fredebel.com);


foreach my $domain (@domainlist) {
  my ($differrors, $checkerrors);
  say "\n\n>>>> running checks for $domain\n";
  my $dig1 = get_dig($domain, $serverlist[0]);
  my $dig2 = get_dig($domain, $serverlist[1]);

  # if we get lucky and both digs are identical, we bail early
  my $sums = check_md5($dig1, $dig2);
  say '';
  if ($sums) {
  } else {
    say "digs don't plaintext match";
    $differrors++;
  }

  # let's sort the files and check again, for kicks
  my $sorteddig1 = text_unique_sort($dig1);
  my $sorteddig2 = text_unique_sort($dig2);
  my $sortedsums = check_md5($sorteddig1, $sorteddig2);
  if ($sortedsums) {
  } else {
    say "sorted digs don't plaintext match";
    $differrors++;
  }
  
  #  # let's deal with arrayrefs from here on out
  #  # ...UNUSED, APPARENTLY
  #
  #  $digarray1 = get_dig_array($dig1);
  #  $digarray2 = get_dig_array($dig2);
  #
  #  my $soa1 = get_soa($dig1);
  #  my $soa2 = get_soa($dig2);


  # let's try the modules
  #my $zonefile = DNS::ZoneParse->new("/path/to/dns/zonefile.db", $origin);
  # NOTE: the leading backslash indicates reading from a string instead of from a file
  my $zonefile1 = DNS::ZoneParse->new(\$dig1, $domain);
  my $zonefile2 = DNS::ZoneParse->new(\$dig2, $domain);


  # let's run our gaggle of tests
  check_soa($zonefile1, $zonefile2);
  check_ns($zonefile1, $zonefile2);
  check_mx($zonefile1, $zonefile2);
  check_a($zonefile1, $zonefile2);
  check_cname($zonefile1, $zonefile2);
  check_txt($zonefile1, $zonefile2);
  #
  # UNTESTED
  check_ptr($zonefile1, $zonefile2);
  check_srv($zonefile1, $zonefile2);


  # so let's do plain old diffs on the two zone files
  # we get a carp if there is no ending to the files, so...
  my $first   = $sorteddig1;
  chomp $first;
  $first      .= "\n";
  my $second  = $sorteddig2;
  chomp $second;
  $second     .= "\n";
  #
  my $diff = diff \$first, \$second, { STYLE => "OldStyle" };
  if ($diff) {
    say "\n**** DIFF ****\n";
    say $diff;
  }
 
  # NOTE: we spool all output and covnert to Windows line endings, for sane ticketing
  #
  # NOT IMPLEMENTED YET
  #
  # my $spool;
  # open my $handle, '>', \$spool or die "open \$spool failed: $!";
  # select $handle
  # print all I want, it all gets spooled
  #
  #
  # fix the line endings
  # $spool =~ s|\n|\r\n|g;
  #
  # now we flush the spool
  # select(STDOUT);
  # say $spool;
  # close $handle;

  say '##################################################';
  say '';
}




# subs

sub get_dig {
  my ($domain, $server) = @_;

  # relevant dig options
  # +nottlid : do not display the TTL when printing the record
  # +noall   : clear all display flags 
  #
  # NOT SORTED, but dupe SOA at the end of the file
  my $dig =  "dig \@$server -t AXFR +nottlid $domain | grep -Evi 'rrsig|dnskey|nsec|caa|^\$|^;'";
  # NOTE: sort happens later, before the old-school diff
  #my $dig =  "dig \@$server -t AXFR $domain | grep -Evi 'rrsig|dnskey|nsec|caa|^\$|^;' | sort -u";
  # NOTE: I get this when doing the sort:
  # Unparseable line (Unknown origin)
  # fredebel.com. 86400 IN NS ns14.redfishnetworks.com.
  #  at ./digdiff.pl line 61.

  say "running $dig";
  $dig    =  `$dig`;

  # we don't want any DOS line endings, if they ever appear
  $dig =~ s|/r/n|/n|g;
  chomp $dig;

  # complain loudly if we don't get a valid zone transfer
  unless ($dig =~ /SOA/) {
    say "\n     ***** BAD ZONE TRANSFER *****";
    say $dig;
    next;
  }

  # this returns string data
  return $dig;
}



# get dig arrays
sub get_dig_array {
  my $dig = shift;

  # first we get rid of tabs
  # ___FIXME___ this isn't having any effect
  $dig =~ s/\/t/  /g;

  my @dig = split /\n/, $dig;

  # this returns dig string data split into an array ref
  return \@dig;
}



# we don't care about the actual data, only that we can later compare these contrived arrays in array_compare()
sub hash_to_sorted_array {
  my $hash = shift;

  my @array;
  foreach (sort keys %$hash) {
    push @array, $_;
    push @array, $$hash{$_};
  }

  return \@array;
}



sub array_compare {
  my ($array1, $array2) = @_;

  # quick and dirty Array::Compare internals trick
  my $one = join '', @$array1;
  my $two = join '', @$array2;
  return 1 if $one eq $two;

  return 0;
}






# tests

sub check_md5 {
  my ($dig1, $dig2) = @_;

  my $sum1 = md5_hex($dig1);
  my $sum2 = md5_hex($dig2);
  return 1 if $sum1 eq $sum2;

  return 0;
}



sub check_soa {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking SOA records";

  my $SOA1 = $zonefile1->soa();
  my $SOA2 = $zonefile2->soa();

  # convert to sorted arrays and compare the strings
  my $sorted1 = hash_to_sorted_array($SOA1);
  my $sorted2 = hash_to_sorted_array($SOA2);
  unless (array_compare($sorted1, $sorted2)) {
    say "    SOAs differ";
    # counter not implemented yet
    #$checkerrors++;
    return 1;
  };

  return 0;
}



sub check_ns {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking NS records";

  my $NS1 = $zonefile1->ns();
  my $NS2 = $zonefile2->ns();

=pod
$VAR1 = [
  {
    'ttl' => '86400',
    'host' => 'ns8.redfishnetworks.com.',
    'ORIGIN' => 'fredebel.com.',
    'class' => 'IN',
    'name' => 'fredebel.com.'
  }
=cut

  my @list1;
  foreach (@$NS1) {
    push @list1, $$_{host};
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$NS2) {
    push @list2, $$_{host};
  }
  @list2 = sort @list2;

  #say "NS records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "    NS records differ";
    # NOTE:  at this point, we aren't using any return values for the records checks
    #return 1;
  };
}



sub check_mx {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking MX records";

  my $MX1 = $zonefile1->mx();
  my $MX2 = $zonefile2->mx();

=pod
$VAR1 = [
  {
    'priority' => '10',
    'class' => 'IN',
    'ttl' => '86400',
    'ORIGIN' => 'fredebel.com.',
    'name' => 'fredebel.com.',
    'host' => 'upperroomreport.com.'
  }
=cut

  my @list1;
  foreach (@$MX1) {
    push @list1, "$$_{host}:$$_{priority}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$MX2) {
    push @list2, "$$_{host}:$$_{priority}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    MX records differ";
  }
}



sub check_a {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking A records";

  my $A1 = $zonefile1->a();
  my $A2 = $zonefile2->a();

=pod
$VAR1 = [
  {
    'class' => 'IN',
    'name' => 'fredebel.com.',
    'ORIGIN' => 'fredebel.com.',
    'ttl' => '86400',
    'host' => '184.178.101.189'
  }

=cut

  my @list1;
  foreach (@$A1) {
    push @list1, "$$_{name}:$$_{host}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$A2) {
    push @list2, "$$_{name}:$$_{host}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    A records differ";
  }
}



sub check_cname {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking CNAME records";

  my $CNAME1 = $zonefile1->cname();
  my $CNAME2 = $zonefile1->cname();

  my @list1;
  foreach (@$CNAME1) {
    push @list1, "$$_{name}:$$_{host}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$CNAME2) {
    push @list2, "$$_{name}:$$_{host}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    CNAMEs differ";
  }
}



sub check_txt {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking TXT records";

  my $TXT1 = $zonefile1->txt();
  my $TXT2 = $zonefile2->txt();

=pod
$VAR1 = [
  {
    'ORIGIN' => 'fredebel.com.',
    'class' => 'IN',
    'name' => 'fredebel.com.',
    'text' => 'google-site-verification=SU_21NN-cMs8XKMC_ZBkJv2inGc8bdJhA8upO765P-M',
    'ttl' => '86400'

  }

=cut

  my @list1;
  foreach (@$TXT1) {
    push @list1, "$$_{name}:$$_{text}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$TXT2) {
    push @list2, "$$_{name}:$$_{text}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    TXT records differ";
  }
}



sub check_ptr {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking PTR records";

  my $PTR1 = $zonefile1->ptr();
  my $PTR2 = $zonefile2->ptr();

=pod
$VAR1 = [
  {
    'ORIGIN' => 'fredebel.com.',
    'class' => 'IN',
    'name' => 'fredebel.com.',
    'text' => 'google-site-verification=SU_21NN-cMs8XKMC_ZBkJv2inGc8bdJhA8upO765P-M',
    'ttl' => '86400'

  }
=cut

  my @list1;
  foreach (@$PTR1) {
    push @list1, "$$_{name}:$$_{host}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$PTR2) {
    push @list2, "$$_{name}:$$_{host}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    PTR records differ";
  }
}


sub check_srv {
  my ($zonefile1, $zonefile2) = @_;
  say "\nchecking SRV records";

  my $SRV1 = $zonefile1->srv();
  my $SRV2 = $zonefile2->srv();

=pod
$VAR1 = [
  {
    'weight' => '5',
    'name' => '_sip._tcp.fredebel.com.',
    'ttl' => '86400',
    'host' => 'sipserver.fredebel.com.',
    'class' => 'IN',
    'ORIGIN' => 'fredebel.com.',
    'priority' => '0',
    'port' => '5060'
  }
];
=cut

  my @list1;
  foreach (@$SRV1) {
    push @list1, "$$_{name}:$$_{host}";
  }
  @list1 = sort @list1;

  my @list2;
  foreach (@$SRV2) {
    push @list2, "$$_{name}:$$_{host}";
  }
  @list2 = sort @list2;

  unless ( array_compare(\@list1, \@list2) ) {
    say "    SRV records differ";
  }
}



sub text_unique_sort {
  my $text = shift;

  my @array = split "\n", $text;
  # perlfaq method
  my %seen = ();
  my @unique = grep { ! $seen{ $_ }++ } @array;
  $text = join "\n", @unique;

  return $text;
}