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