#!/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 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 $server1 = 'sustain.joeykelly.net';
#my $server2 = '192.168.2.2';
my $server2 = 'sustain.joeykelly.net';
$server2    = 'asher.bayoulighting.com';    # testing
my @serverlist = ($server1, $server2);


my @domainlist = qw(joeykelly.net fredebel.com);
#my @domainlist = qw(fredebel.com);
#@domainlist = qw(16.172.in-addr.arpa.);


foreach my $domain (@domainlist) {
  my ($differrors, $checkerrors);
  say ">>>> running checks for $domain";
  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) {
    #say "digs match";
    #exit;
    # NOTE: let's continue our tests, in the absense of failed dig matches to test against
  } 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) {
    #say "sorted digs match";
    #exit;
    # NOTE: let's continue our tests, in the absense of failed dig matches to test against
  } else {
    say "sorted digs don't plaintext match";
    $differrors++;
  }
  
=pod
  # let's deal with arrayrefs from here on out
  $digarray1 = get_dig_array($dig1);
  $digarray2 = get_dig_array($dig2);

  my $soa1 = get_soa($dig1);
  my $soa2 = get_soa($dig2);
  check_soa($soa1, $soa2);
=cut


  # 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);

=pod
  my $SOA = $zonefile1->soa();
  #say keys %$SOA;
  foreach (keys %$SOA) {
    #say "$_\t$$SOA{$_}";
  }
  say "serial $$SOA{serial}";
  say '';

  my $NS = $zonefile->ns();
  say $NS;
  say Dumper(@$NS);
=cut

  # let's run our gaggle of tests
  check_soa($zonefile1, $zonefile2);
  #say "check_soa($zonefile1, $zonefile2)";

  # ___FIXME___ gotta clean up that crap above ASAP

  # let's work on other tests 
  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
  #my $diff = diff \$string1,   \$string2,  { STYLE => "OldStyle" };
  #my $diff = diff $zonefile1, $zonefile2, { STYLE => "OldStyle" };
  #my $diff = diff \$$zonefile1, \$$zonefile2, { STYLE => "OldStyle" };
  # we get a carp if there is not 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
  #
  # 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) = @_;

  #say "running \$dig = `dig \@$server -t AXFR $domain | grep -Evi 'rrsig|dnskey|nsec|^\$|^;' | sort -u`";
  #say '';
  #my $dig =  `dig \@$server -t AXFR $domain | grep -Evi 'rrsig|dnskey|nsec|^\$|^;' | sort -u`;

  # options
  # +nottlid : do not display the TTL when printing the record
  # +noall   : clear all display flags 
  #
  my $dig =  "dig \@$server -t AXFR +nottlid $domain | grep -Evi 'rrsig|dnskey|nsec|caa|^\$|^;'";  # NOT SORTED, but dupe SOA at the end of the file
  # NOTE: sort happens later, before the old-school diff
  #my $dig =  "dig \@$server -t AXFR $domain | grep -Evi 'rrsig|dnskey|nsec|caa|^\$|^;' | sort -u";
  # ___FIXME___ 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`;  # NOT SORTED, but dupe SOA at the end of the file (but see above, is there a sort -u?)

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

  # complain loudly if we don't get a valid zone transfer
  say "     ***** BAD ZONE TRANSFER *****" unless $dig =~ /SOA/;

  # this returns string data
  return $dig;
}



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

  # first we get rid of tabs
  #$dig =~ s|/t|  |g;
  # NOTE: 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) = @_;
  #say "passed \$array1:";
  #say "\$array1 = " . $array1;
  #say Dumper($array1);
  #say Dumper($array2);

  # quick and dirty Array::Compare internals trick
  my $one = join '', @$array1;
  my $two = join '', @$array2;
  #say "serialized \@1 = $one";
  #say "serialized \@2 = $two";
  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 "passed check_soa zonefiles ($zonefile1, $zonefile2)";
  say "\nchecking SOA records";

  my $SOA1 = $zonefile1->soa();
  my $SOA2 = $zonefile2->soa();
  #say "Dumper(\$SOA1) = ";
  #say Dumper($SOA1);
  #say "Dumper(\$SOA2) = ";
  #say Dumper($SOA2);
  #
  #say keys %$SOA;
  #foreach (keys %$SOA1) {
  #  say "$_\t$$SOA1{$_}";
  #}
  #say "serial 1 = $$SOA1{serial}";
  #say "serial 2 = $$SOA2{serial}";
  #say '';

  #say "SOAs match" if array_compare($SOA1, $SOA2);
  #say "SOA1 = " . $SOA1;
  #say "SOA2 = " . $SOA2;
  # convert to sorted arrays and compare the strings
  my $sorted1 = hash_to_sorted_array($SOA1);
  my $sorted2 = hash_to_sorted_array($SOA2);
  #say "\$sorted1 = $sorted1";
  #say "\$sorted2 = $sorted1";
  # arrange this as needed
  #say "SOAs match"  if array_compare($sorted1, $sorted2);
  #say "SOAs differ" unless array_compare($sorted1, $sorted2);
  unless (array_compare($sorted1, $sorted2)) {
    say "SOAs differ";
    #$checkerrors++;
    return 1;
  };

  # what are these for?
  #my @keys1 = keys %$SOA1;
  #my @keys2 = keys %$SOA2;

  return 0;
}



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

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

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

  my @list1;
  foreach (@$NS1) {
    #say $_;
    #say keys %$_;
    #say $$_{host};
    push @list1, $$_{host};
    #say $$NS1[$_]{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";
    return 1;
  };
}



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

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

=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;
  #say @list1;

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

  #say "MX records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "MX records differ";
    return 1;
  }
}



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

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

=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;
  #say @list1;

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

  #say "A records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "A records differ";
    return 1;
  }

  return 0;
}



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

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

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

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

  #say "CNAMEs match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "CNAMEs differ";
    return 1;
  }
}



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

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

=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;
  #say @list1;

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

  #say "TXT records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "TXT records differ";
    return 1;
  }
}



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

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

=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;
  #say @list1;

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

  #say "PTR records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "PTR records differ";
    return 1;
  }
}


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

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

=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;
  #say @list1;

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

  #say "SRV records match"  if array_compare(\@list1, \@list2);
  unless ( array_compare(\@list1, \@list2) ) {
    say "SRV records differ";
    return 1;
  }
}



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;
}