Perl wrapper script for DNS checks using zonemaster.labs.nic.cz/backend

zonemaster-wrapper.pl

#!/usr/bin/perl -w
# -*-mode:cperl -*-

=pod
Description:
(Some) automated checks of DNS server from
- https://www.iana.org/help/nameserver-requirements
- https://zonemaster.labs.nic.cz
Usage:
- e.g.: ./zonemaster-wrapper.pl --domains=wikipedia.org,google.com

Date created: 2020-07
Author: Vojtech Prusa
=cut
use strict;
use warnings;

use JSON qw(decode_json);
use JSON qw(encode_json);

use Data::Dumper qw(Dumper);
use Getopt::Long qw(GetOptions);

use DBI ();

# use 5.008003; # may be newer
use 5.016003; # current version
########################################################################

package SLog;
use Data::Dumper qw(Dumper);

use constant {
  print_args                        => 'print_args',
  print_info                        => 'print_info',
  getTargetDomains_retArr           => 'getTargetDomains_retArr',
  targetDomains                     => 'targetDomains',
  checkNo1                          => 'checkNo1',
  checkNo1_targetDomainItem         => 'checkNo1_targetDomainItem',
  checkNo1_targetDomainItemRes      => 'checkNo1_targetDomainItemRes',
  checkNo1_targetDomainItemResLines => 'checkNo1_targetDomainItemResLines',
  checkNoX_cmdRes                   => 'checkNoX_cmdRes',
  checkNoX_malformed                => 'checkNoX_malformed',
  checkNoX_targetDomain             => 'checkNoX_targetDomain',
  checkNoX_resultId                 => 'checkNoX_resultId',
  checkNoX_curlCmd                  => 'checkNoX_curlCmd',
  checkNoX_iterateOverDecodedJSON   => 'checkNoX_itearetOverDecodedJSON',
  checkNoX_decodedJSONResults       => 'checkNoX_decodedJSONResults',
  checkNoX_notInfoRes               => 'checkNoX_notInfoRes',
  checkNoX_retryLimitReached        => 'checkNoX_retryLimitReached',
  checkNoX_skipTopLevelDomain       => 'checkNoX_skipTopLevelDomain'
  # => '',
};

my @SHOULD_LOG_ALL = (
  print_args,
  print_info,
  getTargetDomains_retArr,
  targetDomains,
  checkNo1,
  checkNo1_targetDomainItem,
  checkNo1_targetDomainItemRes,
  checkNo1_targetDomainItemResLines,
  checkNoX_cmdRes,
  checkNoX_malformed,
  checkNoX_resultId,
  checkNoX_targetDomain,
  checkNoX_curlCmd,
  checkNoX_iterateOverDecodedJSON,
  checkNoX_decodedJSONResults,
  checkNoX_notInfoRes,
  checkNoX_retryLimitReached
);

my @SHOULD_LOG_DEFAULT = (
  # print_args,
  print_info,
  # getTargetDomains_retArr,
  targetDomains,
  checkNo1,
  checkNo1_targetDomainItem,
  # checkNo1_targetDomainItemRes,
  # checkNo1_targetDomainItemResLines,
  # checkNoX_cmdRes,
  checkNoX_malformed,
  checkNoX_resultId,
  checkNoX_targetDomain,
  # checkNoX_curlCmd,
  # checkNoX_iterateOverDecodedJSON,
  # checkNoX_decodedJSONResults,
  checkNoX_notInfoRes,
  checkNoX_retryLimitReached,
  checkNoX_skipTopLevelDomain
);

my @SHOULD_LOG = @SHOULD_LOG_DEFAULT;

sub Log {
  if (scalar(@_) > 1) {
    my ($name, @val) = @_;
    my @prefix = split("_", $name);
    if ($name ~~ SLog->print_info) {
      print @val;
    } elsif ($name ~~ SLog->print_args && $name ~~ @SHOULD_LOG) {
      print @val;
    } elsif ($name ~~ @SHOULD_LOG || $prefix[0] ~~ @SHOULD_LOG) {
      print "$name ";
      print Dumper(@val);
    }
  } else {
    print Dumper(@_);
  }

}

package main;

my $VERSION = '0.0.1';

# Wrapper for case when you do not want to call SLog::Log() but Log() because type speed matters
sub Log {
  SLog::Log(@_);
}

## Set defaults for all the options, then read them in from command line
my %arg = (
  verbose => 0,
  quiet   => 0,
  help    => 0,
  domains => 0
);

########################################################################
my $optResult = GetOptions(
  \%arg,
  'verbose',
  'quiet',
  'help|h',
  'domains=s'
) or help();

$arg{help} and help();

Log(SLog->print_args, "================\n");
Log(SLog->print_args,  "ARG ARRAY => " . Dumper \%arg);
Log(SLog->print_args,  "================\n");
########################################################################

sub main {
  `[ -d "./logs" ] || mkdir ./logs`;

  if ($arg{verbose} ne 0) {
    @SHOULD_LOG = @SHOULD_LOG_ALL;
  }
  if ($arg{quiet} ne 0) {
    @SHOULD_LOG = ();
  }
  checkNSReqs();
}

########################################################################
sub help {
  Log(SLog->print_info, "Usage: $0 configfile [options]\n");
  Log(SLog->print_info, "    --verbose|--quiet ; default will print some information and data.\n");
  Log(SLog->print_info, "    --domains=<listOfDomains> ; g.e. --domains=google.com,wikipedia.org \n");
  exit 0;
}

sub checkNoX {
  my $targetDomain = $_[0];
  Log(SLog->checkNoX_targetDomain, $targetDomain);

  my $curlCmd = "curl -s -X POST https://zonemaster.labs.nic.cz/backend/ -H \"Host: zonemaster.labs.nic.cz\""
    . " -H \"Accept: application/json\" "
    . "-d '{\"jsonrpc\":\"2.0\",\"id\":9,\"method\":\"start_domain_test\",\"params\":{\"ipv4\":true,\"ipv6\":true,\"domain\":\"$targetDomain\"}}'";
  my $curlOut = "./logs/dnscheck.ask.$targetDomain.log";
  my $cmdRes = `$curlCmd > $curlOut && cat $curlOut`;
  Log(SLog->checkNoX_cmdRes, $cmdRes);
  my ($resultId) = $cmdRes =~ /.*result":"([0-9A-Za-z]*)".*/;
  Log(SLog->checkNoX_resultId, $resultId);

  sub checkNoXResults {
    my $targetDomain = $_[0];
    my $resultId = $_[1];
    my $limitRec = $_[2];
    if ($limitRec < 0) {
      Log(SLog->checkNoX_retryLimitReached, "checkNoX_retryLimitReached: 'limitRec' < 0");
      return;
    }
    my $curlResCmd = "curl -s -X POST https://zonemaster.labs.nic.cz/backend/ -H \"Host: zonemaster.labs.nic.cz\""
      . " -H \"Accept: application/json\""
      . " -d '{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"get_test_results\",\"params\":{\"id\":\"$resultId\",\"language\":\"en\"}}'";
    my $curlResOut = "./logs/dnscheck.res.$targetDomain.$resultId";
    my $curlResOutLog = "$curlResOut.log";
    my $curlResOutJson = "$curlResOut.json";
    my $cmdResRes = `$curlResCmd > $curlResOutLog`;
    if (`cat $curlResOutLog` =~ m/malformed/) {
      my $sleepInterval = 5; # TODO parametrize
      Log(SLog->checkNoX_malformed, "malformed, sleep($sleepInterval), limit: $limitRec");
      sleep($sleepInterval);
      checkNoXResults($targetDomain, $resultId, --$limitRec);
      return;
    }

    Log(SLog->checkNoX_curlCmd, $curlResCmd);
    my $cmdResData = `cat $curlResOutLog`;
    Log(SLog->checkNoX_cmdRes, $cmdResData);
    my $dCmdData = decode_json($cmdResData);
    Log(SLog->checkNoX_decodedJSONResults, $dCmdData->{result}{results});

    my @notInfoRes = ();
    foreach (@{$dCmdData->{result}{results}}) {
      Log(SLog->checkNoX_iterateOverDecodedJSON, $_);
      push(@notInfoRes, $_) if ($_->{level} !~ m/INFO/);
    }

    my $encodedJson = encode_json(\@notInfoRes);
    $encodedJson =~ s/\\n//g;
    Log(SLog->checkNoX_notInfoRes, decode_json($encodedJson));
    open my $fh, ">", "$curlResOutJson";
    print $fh JSON->new->ascii->pretty->encode(\@notInfoRes);
    close $fh;
  }
  my $limitGlobalRec = 20; # TODO parametrize
  checkNoXResults($targetDomain, $resultId, $limitGlobalRec);
}

sub checkNSReqs {
  Log(SLog->print_info, "Requirements for Name Servers:\n");
  if ($arg{domains} ne 0) {
    my @targetDomains = split(',', $arg{domains});
    my $i = 0;
    # my $ilimit = 6;
    foreach my $domain (@targetDomains) {
      # lets skip top level domains
      if ($domain !~ /\./) {
        Log(SLog->checkNoX_skipTopLevelDomain, "checkNoX_skipTopLevelDomain");
        next;
      }
      checkNoX($domain);
      $i++;
      # return if ($i > $ilimit);
    }
    Log(SLog->print_info, "Done.\n");
  } else {
    help();
  }
}

main();

#