# Brief help module to define the exception we use for early exits. package Zonemaster::Engine::Exception::NormalExit; use v5.26; use warnings; use parent 'Zonemaster::Engine::Exception'; # The actual interesting module. package Zonemaster::CLI; use v5.26; use warnings; use version; our $VERSION = version->declare( "v8.0.1" ); use Locale::TextDomain 'Zonemaster-CLI'; use Encode; use File::Slurp; use Getopt::Long qw[GetOptionsFromArray :config gnu_compat bundling no_auto_abbrev]; use JSON::XS; use List::Util qw[max uniq]; use Net::IP::XS; use Pod::Usage; use POSIX qw[setlocale LC_MESSAGES LC_CTYPE]; use Readonly; use Scalar::Util qw[blessed]; use Time::HiRes; use Try::Tiny; use Zonemaster::CLI::TestCaseSet; use Zonemaster::Engine::Exception; use Zonemaster::Engine::Logger::Entry; use Zonemaster::Engine::Normalization qw[normalize_name]; use Zonemaster::Engine::Translator; use Zonemaster::Engine::Util qw[parse_hints]; use Zonemaster::Engine::Validation qw[validate_ipv4 validate_ipv6]; use Zonemaster::Engine; use Zonemaster::LDNS; our %numeric = Zonemaster::Engine::Logger::Entry->levels; our $JSON = JSON::XS->new->allow_blessed->convert_blessed->canonical; our $SCRIPT = $0; Readonly our $EXIT_SUCCESS => 0; Readonly our $EXIT_GENERIC_ERROR => 1; Readonly our $EXIT_USAGE_ERROR => 2; Readonly our $DS_RE => qr/^(?:[[:digit:]]+,){3}[[:xdigit:]]+$/; STDOUT->autoflush( 1 ); sub my_pod2usage { my ( %opts ) = @_; pod2usage( -input => $SCRIPT, -output => $opts{output}, -verbose => $opts{verbosity}, -exitcode => 'NOEXIT', ); return; } # Returns an integer representing an OS exit status. sub run { my ( $class, @argv ) = @_; my $opt_count = 0; my @opt_ds = (); my $opt_dump_profile = 0; my $opt_elapsed = 0; my $opt_encoding = undef; my $opt_help = 0; my $opt_hints; my $opt_ipv4 = undef; my $opt_ipv6 = undef; my $opt_json = undef; my $opt_json_stream = 0; my $opt_json_translate = undef; my $opt_level = 'NOTICE'; my $opt_list_tests = 0; my $opt_locale = undef; my @opt_ns = (); my $opt_nstimes = 0; my $opt_profile; my $opt_progress = undef; my $opt_raw; my $opt_restore; my $opt_save; my $opt_show_level = 1; my $opt_show_module = 0; my $opt_show_testcase = 0; my $opt_sourceaddr4; my $opt_sourceaddr6; my $opt_stop_level = ''; my @opt_test = (); my $opt_time = 1; my $opt_version = 0; { local $SIG{__WARN__} = sub { print STDERR $_[0] }; GetOptionsFromArray( \@argv, 'count!' => \$opt_count, 'ds=s' => \@opt_ds, 'dump-profile!' => \$opt_dump_profile, 'dump_profile!' => \$opt_dump_profile, 'elapsed!' => \$opt_elapsed, 'encoding=s' => \$opt_encoding, 'hints=s' => \$opt_hints, 'help|h|usage|?!' => \$opt_help, 'ipv4!' => \$opt_ipv4, 'ipv6!' => \$opt_ipv6, 'json!' => \$opt_json, 'json-stream!' => \$opt_json_stream, 'json_stream!' => \$opt_json_stream, 'json-translate!' => \$opt_json_translate, 'json_translate!' => \$opt_json_translate, 'level=s' => \$opt_level, 'list-tests!' => \$opt_list_tests, 'list_tests!' => \$opt_list_tests, 'locale=s' => \$opt_locale, 'ns=s' => \@opt_ns, 'nstimes!' => \$opt_nstimes, 'profile=s' => \$opt_profile, 'progress!' => \$opt_progress, 'raw!' => \$opt_raw, 'restore=s' => \$opt_restore, 'save=s' => \$opt_save, 'show-level!' => \$opt_show_level, 'show_level!' => \$opt_show_level, 'show-module!' => \$opt_show_module, 'show_module!' => \$opt_show_module, 'show-testcase!' => \$opt_show_testcase, 'show_testcase!' => \$opt_show_testcase, 'sourceaddr4=s' => \$opt_sourceaddr4, 'sourceaddr6=s' => \$opt_sourceaddr6, 'stop-level=s' => \$opt_stop_level, 'stop_level=s' => \$opt_stop_level, 'test=s' => \@opt_test, 'time!' => \$opt_time, 'version!' => \$opt_version, ) or do { my_pod2usage( verbosity => 0, output => \*STDERR ); return 2; }; } if ( $opt_help ) { my_pod2usage( verbosity => 1, output => \*STDOUT ); say "Severity levels from highest to lowest:"; say " CRITICAL, ERROR, WARNING, NOTICE, INFO, DEBUG, DEBUG2, DEBUG3"; return 0; } $opt_level = uc $opt_level; $opt_stop_level = uc $opt_stop_level; my @accumulator; my %counter; my $printed_something; if ( $opt_locale ) { undef $ENV{LANGUAGE}; $ENV{LC_ALL} = $opt_locale; } # Set LC_MESSAGES and LC_CTYPE separately # (https://www.gnu.org/software/gettext/manual/html_node/Triggering.html#Triggering) if ( not defined setlocale( LC_MESSAGES, "" ) ) { my $locale = ( $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} ); say STDERR __x( "Warning: setting locale category LC_MESSAGES to {locale} failed -- is it installed on this system?", locale => $locale ) . "\n\n"; } if ( not defined setlocale( LC_CTYPE, "" ) ) { my $locale = ( $ENV{LC_ALL} || $ENV{LC_CTYPE} ); say STDERR __x( "Warning: setting locale category LC_CTYPE to {locale} failed -- is it installed on this system?", locale => $locale ) . "\n\n"; } if ( $opt_version ) { print_versions(); return $EXIT_SUCCESS; } if ( $opt_list_tests ) { print_test_list(); return $EXIT_SUCCESS; } # errors and warnings if ( defined $opt_encoding ) { say STDERR __( "Warning: deprecated --encoding, simply remove it from your usage." ); } if ( $opt_json_stream and defined $opt_json and not $opt_json ) { say STDERR __( "Error: --json-stream and --no-json cannot be used together." ); return $EXIT_USAGE_ERROR; } if ( defined $opt_json_translate ) { unless ( $opt_json or $opt_json_stream ) { printf STDERR __( "Warning: --json-translate has no effect without either --json or --json-stream." ) . "\n"; } if ( $opt_json_translate ) { printf STDERR __( "Warning: deprecated --json-translate, use --no-raw instead." ) . "\n"; } else { printf STDERR __( "Warning: deprecated --no-json-translate, use --raw instead." ) . "\n"; } } # align values $opt_json = 1 if $opt_json_stream; $opt_raw //= defined $opt_json_translate ? !$opt_json_translate : 0; # Filehandle for diagnostics output my $fh_diag = ( $opt_json or $opt_raw or $opt_dump_profile ) ? *STDERR # Structured output mode (e.g. JSON) : *STDOUT; # Human readable output mode my $show_progress = $opt_progress // !!-t STDOUT && !$opt_json && !$opt_raw; if ( $opt_profile ) { say $fh_diag __x( "Loading profile from {path}.", path => $opt_profile ); my $json = read_file( $opt_profile ); my $foo = Zonemaster::Engine::Profile->from_json( $json ); my $profile = Zonemaster::Engine::Profile->default; $profile->merge( $foo ); Zonemaster::Engine::Profile->effective->merge( $profile ); } if ( defined $opt_sourceaddr4 ) { local $@; eval { Zonemaster::Engine::Profile->effective->set( q{resolver.source4}, $opt_sourceaddr4 ); 1; } or do { say STDERR __x( "Error: invalid value for --sourceaddr4: {reason}", reason => $@ ); return $EXIT_USAGE_ERROR; }; } if ( defined $opt_sourceaddr6 ) { local $@; eval { Zonemaster::Engine::Profile->effective->set( q{resolver.source6}, $opt_sourceaddr6 ); 1; } or do { say STDERR __x( "Error: invalid value for --sourceaddr6: {reason}", reason => $@ ); return $EXIT_USAGE_ERROR; }; } { my %all_methods = Zonemaster::Engine->all_methods; my $cases = Zonemaster::CLI::TestCaseSet->new( # Zonemaster::Engine::Profile->effective->get( q{test_cases} ), \%all_methods, ); for my $test ( @opt_test ) { my @modifiers = Zonemaster::CLI::TestCaseSet->parse_modifier_expr( $test ); while ( @modifiers ) { my $op = shift @modifiers; my $term = shift @modifiers; if ( !$cases->apply_modifier( $op, $term ) ) { say STDERR __x( "Error: unrecognized term '{term}' in --test.", term => $term ) . "\n"; return $EXIT_USAGE_ERROR; } } } Zonemaster::Engine::Profile->effective->set( q{test_cases}, [ $cases->to_list ] ), } # These two must come after any profile from command line has been loaded # to make any IPv4/IPv6 option override the profile setting. if ( defined( $opt_ipv4 ) ) { Zonemaster::Engine::Profile->effective->set( q{net.ipv4}, $opt_ipv4 ); } if ( defined( $opt_ipv6 ) ) { Zonemaster::Engine::Profile->effective->set( q{net.ipv6}, $opt_ipv6 ); } if ( $opt_dump_profile ) { do_dump_profile(); return $EXIT_SUCCESS; } if ( $opt_stop_level and not defined( $numeric{$opt_stop_level} ) ) { say STDERR __x( "Failed to recognize stop level '{level}'.", level => $opt_stop_level ); return $EXIT_USAGE_ERROR; } if ( not defined $numeric{$opt_level} ) { say STDERR __( "--level must be one of CRITICAL, ERROR, WARNING, NOTICE, INFO, DEBUG, DEBUG2 or DEBUG3." ); return $EXIT_USAGE_ERROR; } if ( $opt_restore ) { Zonemaster::Engine->preload_cache( $opt_restore ); } my $level_width = 0; foreach ( keys %numeric ) { if ( $numeric{$opt_level} <= $numeric{$_} ) { my $width_l10n = length( decode_utf8( translate_severity( $_ ) ) ); $level_width = $width_l10n if $width_l10n > $level_width; } } my $translator; my %field_width = ( seconds => 7, level => $level_width, module => 12, testcase => 14 ); my %header_names = (); my %remaining_space = (); # Callback defined here so it closes over the setup above. # But we can’t use it right now because the translator isn’t initialized. my $message_printer = sub { my ( $entry ) = @_; print_spinner() if $show_progress; my $entry_level = $entry->level; $counter{ uc $entry_level } += 1; if ( $numeric{ uc $entry_level } >= $numeric{$opt_level} ) { $printed_something = 1; if ( $opt_json and $opt_json_stream ) { my %r; $r{timestamp} = $entry->timestamp if $opt_time; $r{module} = $entry->module if $opt_show_module; $r{testcase} = $entry->testcase if $opt_show_testcase; $r{tag} = $entry->tag; $r{level} = $entry_level if $opt_show_level; $r{args} = $entry->args if $entry->args; $r{message} = $translator->translate_tag( $entry ) unless $opt_raw; say $JSON->encode( \%r ); } elsif ( $opt_json and not $opt_json_stream ) { # Don't do anything } else { my $prefix = q{}; if ( $opt_time ) { $prefix .= sprintf "%*.2f ", ${ field_width { seconds } }, $entry->timestamp; } if ( $opt_show_level ) { $prefix .= $opt_raw ? $entry->level : translate_severity( $entry->level ); my $space_l10n = ${ field_width { level } } - length( decode_utf8( translate_severity( $entry_level ) ) ) + 1; $prefix .= ' ' x $space_l10n; } if ( $opt_show_module ) { $prefix .= sprintf "%-*s ", ${ field_width { module } }, $entry->module; } if ( $opt_show_testcase ) { $prefix .= sprintf "%-*s ", ${ field_width { testcase } }, $entry->testcase; } if ( $opt_raw ) { $prefix .= $entry->tag; my $message = $entry->argstr; my @lines = split /\n/, $message; printf "%s%s %s\n", $prefix, ' ', @lines ? shift @lines : ''; for my $line ( @lines ) { printf "%s%s %s\n", $prefix, '>', $line; } } else { if ( $entry_level eq q{DEBUG3} and scalar( keys %{ $entry->args } ) == 1 and defined $entry->args->{packet} ) { my $packet = $entry->args->{packet}; my $padding = q{ } x length $prefix; $entry->args->{packet} = q{}; printf "%s%s\n", $prefix, $translator->translate_tag( $entry ); foreach my $line ( split /\n/, $packet ) { printf "%s%s\n", $padding, $line; } } else { printf "%s%s\n", $prefix, $translator->translate_tag( $entry ); } } } ## end else [ if ( $opt_json and $opt_json_stream)] } ## end if ( $numeric{ uc $entry_level...}) if ( $opt_stop_level and $numeric{ uc $entry->level } >= $numeric{$opt_stop_level} ) { die( Zonemaster::Engine::Exception::NormalExit->new( { message => "Saw message at level " . $entry->level } ) ); } }; # Instead, hold early messages in a temporary queue and switch to the # actual callback when we are ready. my @held_messages; Zonemaster::Engine->logger->callback( sub { my ( $entry ) = @_; push @held_messages, @_; } ); if ( @argv > 1 ) { say STDERR __( "Only one domain can be given for testing. Did you forget to prepend an option with '--