File Coverage

blib/lib/Mail/TLSRPT/Policy.pm
Criterion Covered Total %
statement 56 56 100.0
branch 3 4 75.0
condition 6 8 75.0
subroutine 12 12 100.0
pod 4 4 100.0
total 81 84 96.4


line stmt bran cond sub pod time code
1             package Mail::TLSRPT::Policy;
2             # ABSTRACT: TLSRPT policy object
3             our $VERSION = '1.20200413.1'; # VERSION
4 8     8   2025 use 5.20.0;
  8         33  
5 8     8   49 use Moo;
  8         15  
  8         49  
6 8     8   2555 use Mail::TLSRPT::Pragmas;
  8         21  
  8         53  
7 8     8   5802 use Mail::TLSRPT::Failure;
  8         33  
  8         7936  
8             has policy_type => (is => 'rw', isa => Enum[qw( tlsa sts no-policy-found )], required => 1);
9             has policy_string => (is => 'rw', isa => ArrayRef, required => 1);
10             has policy_domain => (is => 'rw', isa => Str, required => 1);
11             has policy_mx_host => (is => 'rw', isa => Str, required => 1);
12             has total_successful_session_count => (is => 'rw', isa => Int, required => 1);
13             has total_failure_session_count => (is => 'rw', isa => Int, required => 1);
14 1     1   12646 has failures => (is => 'rw', isa => ArrayRef, required => 0, lazy => 1, builder => sub{return []} );
15              
16              
17 7     7 1 5830 sub new_from_data($class,$data) {
  7         15  
  7         30  
  7         12  
18 7         16 my @failures;
19 7         26 foreach my $failure ( $data->{'failure-details'}->@* ) {
20 12         62 push @failures, Mail::TLSRPT::Failure->new_from_data($failure);
21             }
22             my $self = $class->new(
23             policy_type => $data->{policy}->{'policy-type'},
24             policy_string => $data->{policy}->{'policy-string'} // [],
25             policy_domain => $data->{policy}->{'policy-domain'},
26             policy_mx_host => $data->{policy}->{'mx-host'} // '',
27             total_successful_session_count => $data->{summary}->{'total-successful-session-count'} // 0,
28 7   100     203 total_failure_session_count => $data->{summary}->{'total-failure-session-count'} // 0,
      100        
      50        
      50        
29             failures => \@failures,
30             );
31 7         24323 return $self;
32             }
33              
34              
35 4     4 1 830 sub as_struct($self) {
  4         8  
  4         8  
36 4         78 my @failures = map {$_->as_struct} $self->failures->@*;
  3         416  
37             return {
38 4 100       277 policy => {
39             'policy-type' => $self->policy_type,
40             'policy-string' => $self->policy_string,
41             'policy-domain' => $self->policy_domain,
42             'mx-host' => $self->policy_mx_host,
43             },
44             summary => {
45             'total-successful-session-count' => $self->total_successful_session_count,
46             'total-failure-session-count' => $self->total_failure_session_count,
47             },
48             scalar $self->failures->@* ? ( 'failure_details' => \@failures ) : (),
49             };
50             }
51              
52              
53 3     3 1 5969 sub as_string($self) {
  3         8  
  3         8  
54             return join( "\n",
55             'Policy:',
56             ' Type: '.$self->policy_type,
57             ' String: '. join('; ',$self->policy_string->@*),
58             ' Domain: '.$self->policy_domain,
59             ' MX-Host: '.$self->policy_mx_host,
60             ' Successful-Session-Count: '.$self->total_successful_session_count,
61             ' Failure-Session-Count: '.$self->total_failure_session_count,
62 3         69 map { $_->as_string } $self->failures->@*,
  3         520  
63             );
64             }
65              
66 1     1   2 sub _register_prometheus($self,$prometheus) {
  1         2  
  1         2  
  1         3  
67 1         5 $prometheus->declare('tlsrpt_sessions_total', help=>'TLSRPT tls sessions', type=>'counter' );
68             }
69              
70              
71 1     1 1 2 sub process_prometheus($self,$report,$prometheus) {
  1         2  
  1         2  
  1         2  
  1         2  
72 1         3 $self->_register_prometheus($prometheus);
73 1         36 $prometheus->add('tlsrpt_sessions_total',$self->total_successful_session_count,{
74             result=>'successful',
75             organization_name=>$report->organization_name,
76             policy_type=>$self->policy_type,
77             policy_domain=>$self->policy_domain,
78             policy_mx_host=>$self->policy_mx_host,
79             });
80 1         151 $prometheus->add('tlsrpt_sessions_total',$self->total_failure_session_count,{
81             result=>'failure',
82             organization_name=>$report->organization_name,
83             policy_type=>$self->policy_type,
84             policy_domain=>$self->policy_domain,
85             policy_mx_host=>$self->policy_mx_host,
86             });
87 1 50       131 Mail::TLSRPT::Failure->_register_prometheus($prometheus) if ! scalar $self->failures->@*;
88 1         27 foreach my $failure ( $self->failures->@* ) {
89 3         507 $failure->process_prometheus($self,$report,$prometheus);
90             }
91             }
92              
93 1     1   2 sub _csv_headers($self) {
  1         2  
  1         2  
94             return (
95 1         9 'policy type',
96             'policy string',
97             'policy domain',
98             'policy mx host',
99             'total successful session count',
100             'total failure session count',
101             );
102             }
103              
104 3     3   392 sub _csv_fragment($self) {
  3         6  
  3         4  
105             return (
106 3         48 $self->policy_type,
107             join('; ',$self->policy_string->@*),
108             $self->policy_domain,
109             $self->policy_mx_host,
110             $self->total_successful_session_count,
111             $self->total_failure_session_count,
112             );
113             }
114              
115             1;
116              
117             __END__
118              
119             =pod
120              
121             =encoding UTF-8
122              
123             =head1 NAME
124              
125             Mail::TLSRPT::Policy - TLSRPT policy object
126              
127             =head1 VERSION
128              
129             version 1.20200413.1
130              
131             =head1 SYNOPSIS
132              
133             my $policy = Mail::TLSRPT::Policy->new(
134             policy_type => 'no-policy-found',
135             policy_string => [],
136             policy_domain => 'example.com',
137             polixy_mx_host => 'mx.example.com',
138             total_succerssful_session_count => 10,
139             total_failure_session_count => 2,
140             failures => $failures,
141             );
142              
143             =head1 DESCRIPTION
144              
145             Classes to process tlsrpt policy in a report
146              
147             =head1 CONSTRUCTOR
148              
149             =head2 I<new($class)>
150              
151             Create a new object
152              
153             =head2 I<new_from_data($data)>
154              
155             Create a new object using a data structure, this will create sub-objects as required.
156              
157             =head1 METHODS
158              
159             =head2 I<as_struct>
160              
161             Return the current object and sub-objects as a data structure
162              
163             =head2 I<as_string>
164              
165             Return a textual human readable representation of the current object and its sub-objects
166              
167             =head2 I<process_prometheus($prometheus,$report)>
168              
169             Generate metrics using the given Prometheus::Tiny object
170              
171             =head1 AUTHOR
172              
173             Marc Bradshaw <marc@marcbradshaw.net>
174              
175             =head1 COPYRIGHT AND LICENSE
176              
177             This software is copyright (c) 2020 by Marc Bradshaw.
178              
179             This is free software; you can redistribute it and/or modify it under
180             the same terms as the Perl 5 programming language system itself.
181              
182             =cut