Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Logger refactoring #1302

Merged
merged 13 commits into from
Nov 28, 2023
23 changes: 18 additions & 5 deletions lib/Zonemaster/Engine/Logger.pm
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,9 @@ use JSON::PP;
use Zonemaster::Engine::Profile;
use Zonemaster::Engine::Logger::Entry;

our $TEST_CASE_NAME = 'Unspecified';
our $MODULE_NAME = 'System';

has 'entries' => (
is => 'ro',
isa => 'ArrayRef[Zonemaster::Engine::Logger::Entry]',
Expand All @@ -26,10 +29,12 @@ has 'callback' => ( is => 'rw', isa => 'CodeRef', required => 0, clearer => 'cle
my $logfilter;

sub add {
my ( $self, $tag, $argref ) = @_;
my ( $self, $tag, $argref, $module ) = @_;
mattias-p marked this conversation as resolved.
Show resolved Hide resolved

$module //= $MODULE_NAME;

my $new =
Zonemaster::Engine::Logger::Entry->new( { tag => uc( $tag ), args => $argref } );
Zonemaster::Engine::Logger::Entry->new( { tag => uc( $tag ), args => $argref, testcase => $TEST_CASE_NAME, module => $module } );
$self->_check_filter( $new );
push @{ $self->entries }, $new;

Expand Down Expand Up @@ -58,9 +63,9 @@ sub _check_filter {
}

if ( $logfilter ) {
if ( $logfilter->{ $entry->module } ) {
if ( $logfilter->{ uc $entry->module } ) {
my $match = 0;
foreach my $rule ( @{$logfilter->{ $entry->module }{ $entry->tag }} ) {
foreach my $rule ( @{$logfilter->{ uc $entry->module }{ $entry->tag }} ) {
foreach my $key ( keys %{ $rule->{when} } ) {
my $cond = $rule->{when}{$key};
if ( ref( $cond ) and ref( $cond ) eq 'ARRAY' ) {
Expand Down Expand Up @@ -194,10 +199,18 @@ test run that logged the message.

=over

=item add($tag, $argref)
=item add($tag, $argref, $module)

Adds an entry with the given tag and arguments to the logger object.

C<$module> is optional and will default to
C<$Zonemaster::Engine::Logger::MODULE_NAME> if not set.

The variables C<$Zonemaster::Engine::Logger::MODULE_NAME> and
C<$Zonemaster::Engine::Logger::TEST_CASE_NAME> can be dynamically set to
change the default the default module ("System") or test case
name ("Unspecified").
marc-vanderwal marked this conversation as resolved.
Show resolved Hide resolved

=item json([$level])

Returns a JSON-formatted string with all the stored log entries. If an argument
Expand Down
91 changes: 12 additions & 79 deletions lib/Zonemaster/Engine/Logger/Entry.pm
Original file line number Diff line number Diff line change
Expand Up @@ -34,45 +34,37 @@
my $json = JSON::PP->new->allow_blessed->convert_blessed->canonical;
my $test_levels_config;

__PACKAGE__->mk_ro_accessors(qw(tag args timestamp trace));
__PACKAGE__->mk_ro_accessors(qw(tag args timestamp testcase module));


sub new {
my ( $proto, $attrs ) = @_;
# tag required, args optional, other built
# tag, testcase and module required, args optional, other built

confess "Attribute \(tag\) is required"
if !exists $attrs->{tag};

confess "Attribute \(testcase\) is required"

Check failure on line 47 in lib/Zonemaster/Engine/Logger/Entry.pm

View workflow job for this annotation

GitHub Actions / run-tests (develop, 5.16, ubuntu-20.04)

Attribute (testcase) is required
if !exists $attrs->{testcase};

Check failure on line 48 in lib/Zonemaster/Engine/Logger/Entry.pm

View workflow job for this annotation

GitHub Actions / run-tests (develop, 5.32, ubuntu-20.04)

Attribute (testcase) is required

confess "Attribute \(module\) is required"
if !exists $attrs->{module};

confess "Argument must be a HASHREF: args"
if exists $attrs->{args}
&& ref $attrs->{args} ne 'HASH';

my $time = time() - $start_time;
$time =~ s/,/\./;
$attrs->{timestamp} = $time;
$attrs->{trace} = _build_trace();

# lazy attributes
$attrs->{_module} = delete $attrs->{module} if exists $attrs->{module};
$attrs->{_level} = delete $attrs->{level} if exists $attrs->{level};
$attrs->{_testcase} = delete $attrs->{testcase} if exists $attrs->{testcase};

my $class = ref $proto || $proto;
return Class::Accessor::new( $class, $attrs );
}

sub module {
my $self = shift;

# Lazy default value
if ( !exists $self->{_module} ) {
$self->{_module} = $self->_build_module();
}

return $self->{_module}
}

sub level {
my $self = shift;

Expand All @@ -84,59 +76,6 @@
return $self->{_level}
}

sub testcase {
my $self = shift;

# Lazy default value
if ( !exists $self->{_testcase} ) {
$self->{_testcase} = $self->_build_testcase();
}

return $self->{_testcase}
}

sub _build_trace {
my @trace;

my $i = 0;

# 0 1 2 3 4 5 6 7 8 9 10
# $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash
while ( my @line = caller( $i++ ) ) {
next unless index( $line[3], 'Zonemaster::Engine' ) == 0;
push @trace, [ @line[ 0, 3 ] ];
}

return \@trace;
}

sub _build_module {
my ( $self ) = @_;

foreach my $e ( @{ $self->trace } ) {
if ( $e->[1] eq 'Zonemaster::Engine::Util::info'
and $e->[0] =~ /^Zonemaster::Engine::Test::(.*)$/ )
{
return uc $1;
}
}

return 'SYSTEM';
}

sub _build_testcase {
my ( $self ) = @_;

foreach my $e ( @{ $self->trace } ) {
if ( $e->[1] =~ /^Zonemaster::Engine::Test::([^:]+)::(\1[0-9]+)$/i )
{
return uc $2;
}
}

return 'UNSPECIFIED';
}

sub _build_level {
my ( $self ) = @_;
my $string;
Expand All @@ -145,8 +84,8 @@
$test_levels_config = Zonemaster::Engine::Profile->effective->get( q{test_levels} );
}

if ( exists $test_levels_config->{ $self->module }{ $self->tag } ) {
$string = uc $test_levels_config->{ $self->module }{ $self->tag };
if ( exists $test_levels_config->{ uc $self->module }{ $self->tag } ) {
$string = uc $test_levels_config->{ uc $self->module }{ $self->tag };
}
else {
$string = 'DEBUG';
Expand Down Expand Up @@ -269,13 +208,11 @@

=item module

An auto-generated identifier of the module that created the log entry. If it was generated from a module under Zonemaster::Engine::Test, it will be an
uppercased version of the part of the name after "Zonemaster::Engine::Test". For example, "Zonemaster::Engine::Test::Basic" gets the module identifier "BASIC". If the
entry was generated from anywhere else, it will get the module identifier "SYSTEM".
The name of the module associated to the entry, or "System".

=item testcase

Get uppercased version of method name called in module.
The name of the test case which generated the entry, or "Unspecified".

=item tag

Expand All @@ -290,10 +227,6 @@
The time after the current program started running when this entry was created. This is a floating-point value with the precision provided by
L<Time::HiRes>.

=item trace

A partial stack trace for the call that created the entry. Used to create the module tag. Almost certainly not useful for anything else.

=item level

The log level associated to this log entry.
Expand Down
38 changes: 23 additions & 15 deletions lib/Zonemaster/Engine/Test/Address.pm
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,8 @@ use Zonemaster::Engine::Constants qw[:addresses :ip];
use Zonemaster::Engine::TestMethods;
use Zonemaster::Engine::Util;

sub emit_log { Zonemaster::Engine->logger->add( @_, 'Address' ) }

=head1 NAME

Zonemaster::Engine::Test::Address - Module implementing tests focused on IP addresses of name servers
Expand Down Expand Up @@ -248,7 +250,9 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

sub address01 {
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address01';
push my @results, emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
my %ips;

foreach
Expand All @@ -261,7 +265,7 @@ sub address01 {

if ( $ip_details_ref ) {
push @results,
info(
emit_log(
NAMESERVER_IP_PRIVATE_NETWORK => {
nsname => $local_ns->name->string,
ns_ip => $local_ns->address->short,
Expand All @@ -277,10 +281,10 @@ sub address01 {
} ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})

if ( scalar keys %ips and not grep { $_->tag ne q{TEST_CASE_START} } @results ) {
push @results, info( NO_IP_PRIVATE_NETWORK => {} );
push @results, emit_log( NO_IP_PRIVATE_NETWORK => {} );
}

return ( @results, info( TEST_CASE_END => { testcase => (split /::/, (caller(0))[3])[-1] } ) );
return ( @results, emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address01

=over
Expand All @@ -301,7 +305,9 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

sub address02 {
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address02';
push my @results, emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );

my %ips;
my $ptr_query;
Expand All @@ -328,7 +334,7 @@ sub address02 {
if ( $p ) {
if ( $p->rcode ne q{NOERROR} or not $p->get_records( q{PTR}, q{answer} ) ) {
push @results,
info(
emit_log(
NAMESERVER_IP_WITHOUT_REVERSE => {
nsname => $local_ns->name->string,
ns_ip => $local_ns->address->short,
Expand All @@ -338,7 +344,7 @@ sub address02 {
}
else {
push @results,
info(
emit_log(
NO_RESPONSE_PTR_QUERY => {
domain => $ptr_query,
}
Expand All @@ -350,10 +356,10 @@ sub address02 {
} ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})

if ( scalar keys %ips and not grep { $_->tag ne q{TEST_CASE_START} } @results ) {
push @results, info( NAMESERVERS_IP_WITH_REVERSE => {} );
push @results, emit_log( NAMESERVERS_IP_WITH_REVERSE => {} );
}

return ( @results, info( TEST_CASE_END => { testcase => (split /::/, (caller(0))[3])[-1] } ) );
return ( @results, emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address02

=over
Expand All @@ -374,7 +380,9 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.

sub address03 {
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Address03';
push my @results, emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
my $ptr_query;

my %ips;
Expand All @@ -401,7 +409,7 @@ sub address03 {
if ( $p->rcode eq q{NOERROR} and scalar @ptr ) {
if ( none { name( $_->ptrdname ) eq $local_ns->name->string . q{.} } @ptr ) {
push @results,
info(
emit_log(
NAMESERVER_IP_PTR_MISMATCH => {
nsname => $local_ns->name->string,
ns_ip => $local_ns->address->short,
Expand All @@ -412,7 +420,7 @@ sub address03 {
}
else {
push @results,
info(
emit_log(
NAMESERVER_IP_WITHOUT_REVERSE => {
nsname => $local_ns->name->string,
ns_ip => $local_ns->address->short,
Expand All @@ -422,7 +430,7 @@ sub address03 {
} ## end if ( $p )
else {
push @results,
info(
emit_log(
NO_RESPONSE_PTR_QUERY => {
domain => $ptr_query,
}
Expand All @@ -434,10 +442,10 @@ sub address03 {
} ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})

if ( scalar keys %ips and not grep { $_->tag ne q{TEST_CASE_START} } @results ) {
push @results, info( NAMESERVER_IP_PTR_MATCH => {} );
push @results, emit_log( NAMESERVER_IP_PTR_MATCH => {} );
}

return ( @results, info( TEST_CASE_END => { testcase => (split /::/, (caller(0))[3])[-1] } ) );
return ( @results, emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
} ## end sub address03

1;
Loading
Loading