1package Security::TLSCheck::Checks; 2 3use 5.010; 4use strict; 5use warnings; 6 7use Carp; 8use Scalar::Util qw(blessed); 9use English qw( -no_match_vars ); 10 11use Moose; 12 13use Log::Log4perl::EasyCatch; 14 15 16=head1 NAME 17 18Security::TLSCheck::Checks - Base class for all checks 19 20=encoding utf8 21 22=cut 23 24#<<< 25my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 651 $ =~ /(\d+)/xg ); 26#>>> 27 28 29=head1 SYNOPSIS 30 31As check subclass: 32 33 package Security::TLSCheck::Checks::MyCheck 34 35 use Moose; 36 extends 'Security::TLSCheck::Checks' 37 38 has '+description' => ( default => "Checking my checks"); 39 40 41As caller: 42 43 use Security::TLSCheck::Checks::MyCheck; 44 45 my $check = Security::TLSCheck::Checks::MyCheck->new(); 46 say "Check Name: " . $check->name; 47 say "Check Description: " . $check->description; 48 49 my @results = $check->run_check; 50 51 say "Check runtime: " . $check->runtime; 52 53 54=head1 DESCRIPTION 55 56Base class for all checks. Defines all common attributes, and helper methods. 57 58For a project overview, see the README.md of the Distribution. 59 60 61 62=cut 63 64 65#<<< 66 67has name => ( is => 'ro', isa => 'Str', lazy_build => 1, ); 68has class => ( is => 'ro', isa => 'Str', lazy_build => 1, ); 69has www => ( is => "ro", isa => "Str", lazy_build => 1, ); 70has description => ( is => 'ro', isa => 'Str', default => "no description" ); 71has error => ( is => 'rw', isa => 'Str', ); 72 73has key_figures => ( is => "ro", isa => "ArrayRef[HashRef[Str]]", auto_deref => 1, default => sub { [] } ); 74 75has instance => ( is => 'rw', isa => 'Object', required => 1, handles => [qw(domain category timeout user_agent_name my_hostname other_check)], predicate => "has_instance", clearer => "clear_instance",); 76 77has start_time => ( is => 'rw', isa => 'Num' ); 78has end_time => ( is => 'rw', isa => 'Num' ); 79 80#>>> 81 82 83=head1 METHODS 84 85=head2 BUILD 86 87 88 89=cut 90 91sub BUILD 92 { 93 my $self = shift; 94 95 # Mark position in key_figures with their own number 96 # with this info the key figure data in the result can be 97 # replaces by a ref to the all-time same key_figure 98 # in fork mode, this may save much memory 99 my $key_figures = $self->key_figures; 100 101 for my $pos ( 0 .. $#{$key_figures} ) 102 { 103 $key_figures->[$pos]{pos} = $pos; 104 } 105 106 return $self; 107 } 108 109 110=head2 _build_name 111 112Default name is name of the package, without the basename. 113 114=cut 115 116sub _build_name 117 { 118 my $self = shift; 119 120 ( my $name = $self->class ) =~ s{Security::TLSCheck::Checks::}{}x; 121 122 return $name; 123 124 } 125 126=head2 _build_class 127 128Default name is name of the package, without the basename. 129 130=cut 131 132sub _build_class 133 { 134 return blessed(shift); 135 } 136 137=head2 _build_www 138 139generaters "www.domain" from domain. 140 141Very simple at the moment: only prepends www. 142 143=cut 144 145sub _build_www 146 { 147 my $self = shift; 148 149 return "www." . $self->domain; 150 } 151 152 153=head2 ->runtime 154 155Returns the runtime in seconds of this check. 156 157=cut 158 159 160sub runtime 161 { 162 my $self = shift; 163 164 defined $self->start_time or croak "No start time set!"; 165 defined $self->end_time or croak "No end time set!"; 166 167 return $self->end_time - $self->start_time; 168 } 169 170 171=head2 ->run_check 172 173Default for runing all tests: the tests are started via the method calls 174of key_figures in the result method. 175 176So, this method only calls the result method and returns its return value. 177 178For more complex runs override run_check. 179 180=cut 181 182 183sub run_check 184 { 185 my $self = shift; 186 187 return $self->result; 188 } 189 190 191 192=head2 result 193 194calculates the result, according to the C<key_figures> attribute. 195 196Returns a array(ref) of hashrefs: 197 198 [ 199 { 200 info => { name => "My Name", type => "flag", ... }, 201 value => 3, 202 }, 203 204 ] 205 206=cut 207 208sub result 209 { 210 my $self = shift; 211 212 DEBUG "build result for " . $self->name . ", domain " . $self->domain; 213 my @result = map { $self->_get_value($ARG) } $self->key_figures; 214 DEBUG "OK, result built for " . $self->name . ", domain " . $self->domain; 215 216 return \@result; # wantarray ? @result : \@result; 217 } 218 219 220sub _get_value 221 { 222 my $self = shift; 223 my $key_figure = shift; 224 225 my $source_method = $key_figure->{source}; 226 my $value = $self->$source_method; 227 228 # temp, until we handle more types 229 # when it is only a flag, then switch to 1 or 0 230 $value = $value ? 1 : 0 if $key_figure->{type} eq "flag"; 231 232 return { 233 # name => $key_figure->{name}, 234 # type => $key_figure->{type}, 235 value => $value, 236 info => $key_figure, 237 }; 238 239 } 240 241 242#=head2 key_figure_info_by_name 243# 244#Gets an key_figure info hash(ref) by the name of the check 245# 246#=cut 247# 248#sub key_figure_info_by_name 249# { 250# my $self = shift; 251# 252# 253# 254# } 255 256 257__PACKAGE__->meta->make_immutable; 258 2591; 260