File Coverage

blib/lib/Mail/BIMI/VMC.pm
Criterion Covered Total %
statement 23 217 10.6
branch 0 108 0.0
condition 0 21 0.0
subroutine 8 29 27.5
pod 13 13 100.0
total 44 388 11.3


line stmt bran cond sub pod time code
1             package Mail::BIMI::VMC;
2             # ABSTRACT: Class to model a VMC
3             our $VERSION = '3.20210225'; # VERSION
4 30     30   465 use 5.20.0;
  30         112  
5 30     30   188 use Moose;
  30         58  
  30         204  
6 30     30   196976 use Mail::BIMI::Prelude;
  30         82  
  30         235  
7 30     30   26506 use File::Slurp qw{ read_file write_file };
  30         683403  
  30         2334  
8 30     30   15984 use MIME::Base64;
  30         20771  
  30         2075  
9 30     30   1025 use Term::ANSIColor qw{ :constants };
  30         71  
  30         8424  
10 30     30   16238 use Mail::BIMI::Indicator;
  30         177  
  30         3334  
11 30     30   20947 use Mail::BIMI::VMC::Chain;
  30         202  
  30         88791  
12              
13             extends 'Mail::BIMI::Base';
14             with(
15             'Mail::BIMI::Role::HasError',
16             'Mail::BIMI::Role::HasHTTPClient',
17             'Mail::BIMI::Role::Cacheable',
18             );
19             has uri => ( is => 'rw', isa => 'Str', traits => ['CacheKey'],
20             documentation => 'inputs: URI of this VMC', );
21             has check_domain => ( is => 'ro', isa => 'Str', required => 1, traits => ['CacheKey'],
22             documentation => 'inputs: Domain to check the alt_name against', );
23             has check_selector => ( is => 'ro', isa => 'Str', required => 1, traits => ['CacheKey'],
24             documentation => 'inputs: Selector to check the alt_name against', );
25             has data => ( is => 'rw', isa => 'Str', lazy => 1, builder => '_build_data', traits => ['Cacheable'],
26             documentation => 'inputs: Raw data of the VMC contents; Fetched from authority URI if not given', );
27             has cert_list => ( is => 'rw', isa => 'ArrayRef', lazy => 1, builder => '_build_cert_list', traits => ['Cacheable'],
28             documentation => 'ArrayRef of individual Certificates in the chain' );
29             has chain_object => ( is => 'rw', lazy => 1, builder => '_build_chain_object',
30             documentation => 'Mail::BIMI::VMC::Chain object for this Chain' );
31             has is_valid => ( is => 'rw', lazy => 1, builder => '_build_is_valid', traits => ['Cacheable'],
32             documentation => 'Is this VMC valid' );
33             has vmc_object => ( is => 'rw', lazy => 1, builder => '_build_vmc_object',
34             documentation => 'Mail::BIMI::VMC::Cert object for this VMC Set' );
35             has is_cert_valid => ( is => 'rw', lazy => 1, builder => '_build_is_cert_valid', traits => ['Cacheable'],
36             documentation => 'Is this Certificate Set valid' );
37             has indicator_uri => ( is => 'rw', lazy => 1, builder => '_build_indicator_uri', traits => ['Cacheable'],
38             documentation => 'The URI of the embedded Indicator' );
39             has indicator => ( is => 'rw', lazy => 1, builder => '_build_indicator',
40             documentation => 'Mail::BIMI::Indicator object for the Indicator embedded in this VMC Set' );
41              
42              
43              
44 0     0 1   sub cache_valid_for($self) { return 3600 }
  0            
  0            
  0            
45              
46              
47 0     0 1   sub http_client_max_fetch_size($self) { return $self->bimi_object->options->vmc_max_fetch_size };
  0            
  0            
  0            
48              
49 0     0     sub _build_data($self) {
  0            
  0            
50 0 0         if ( ! $self->uri ) {
51 0           $self->add_error('CODE_MISSING_AUTHORITY');
52 0           return '';
53             }
54 0 0         if ($self->bimi_object->options->vmc_from_file) {
55 0           return scalar read_file $self->bimi_object->options->vmc_from_file;
56             }
57              
58 0           $self->log_verbose('HTTP Fetch: '.$self->uri);
59 0           my $response = $self->http_client->get( $self->uri );
60 0 0         if ( !$response->{success} ) {
61 0 0         if ( $response->{status} == 599 ) {
62 0           $self->add_error('VMC_FETCH_ERROR',$response->{content});
63             }
64             else {
65 0           $self->add_error('VMC_FETCH_ERROR',$response->{status});
66             }
67 0           return '';
68             }
69 0           return $response->{content};
70             }
71              
72 0     0     sub _build_cert_list($self) {
  0            
  0            
73 0           my @certs;
74 0           my $this_cert = [];
75 0           my $data = $self->data;
76 0           foreach my $cert_line ( split(/\n/,$data) ) {
77 0           $cert_line =~ s/\r//;
78 0 0         next if ! $cert_line;
79 0           push $this_cert->@*, $cert_line;
80 0 0         if ( $cert_line =~ /^\-+END CERTIFICATE\-+$/ ) {
81 0 0         push @certs, $this_cert if $this_cert->@*;
82 0           $this_cert = [];
83             }
84             }
85 0 0         push @certs, $this_cert if $this_cert->@*;
86 0           return \@certs;
87             }
88              
89              
90 0     0     sub _build_chain_object($self) {
  0            
  0            
91 0           return Mail::BIMI::VMC::Chain->new( bimi_object => $self->bimi_object, cert_list => $self->cert_list );
92             }
93              
94              
95 0     0     sub _build_vmc_object($self) {
  0            
  0            
96 0 0         return if !$self->chain_object;
97 0 0         return if !$self->chain_object->vmc;
98 0           return $self->chain_object->vmc;
99             }
100              
101 0     0     sub _build_is_cert_valid($self) {
  0            
  0            
102 0 0         return 1 if $self->bimi_object->options->no_validate_cert;
103 0           return $self->chain_object->is_valid;
104             }
105              
106              
107 0     0 1   sub subject($self) {
  0            
  0            
108 0 0         return if !$self->vmc_object;
109 0           return $self->vmc_object->x509_object->subject;
110             }
111              
112              
113 0     0 1   sub not_before($self) {
  0            
  0            
114 0 0         return if !$self->vmc_object;
115 0           return $self->vmc_object->x509_object->notBefore;
116             }
117              
118              
119 0     0 1   sub not_after($self) {
  0            
  0            
120 0 0         return if !$self->vmc_object;
121 0           return $self->vmc_object->x509_object->notAfter;
122             }
123              
124              
125 0     0 1   sub issuer($self) {
  0            
  0            
126 0 0         return if !$self->vmc_object;
127 0           return $self->vmc_object->x509_object->issuer;
128             }
129              
130              
131 0     0 1   sub is_expired($self) {
  0            
  0            
132 0 0         return if !$self->vmc_object;
133 0           my $seconds = 0;
134 0 0         if ($self->vmc_object->x509_object->checkend($seconds)) {
135 0           $self->log_verbose('Cert is expired');
136 0           return 1;
137             }
138             else {
139 0           return 0;
140             }
141             }
142              
143              
144 0     0 1   sub alt_name($self) {
  0            
  0            
145 0 0         return if !$self->vmc_object;
146 0           my $exts = eval{ $self->vmc_object->x509_object->extensions_by_oid() };
  0            
147 0 0         return if !$exts;
148 0 0         return if !exists $exts->{'2.5.29.17'};
149 0           my $alt_name = $exts->{'2.5.29.17'}->to_string;
150 0           $self->log_verbose('Cert alt name '.$alt_name);
151 0           return $alt_name;
152             }
153              
154              
155 0     0 1   sub is_valid_alt_name($self) {
  0            
  0            
156 0 0         return 1 if !$self->check_domain; # Nothing to check against, default to allow
157 0 0         return 1 if $self->bimi_object->options->vmc_no_check_alt;
158 0 0         return 0 if !$self->alt_name;
159 0           my @alt_names = split( ',', lc $self->alt_name );
160 0           my $check_full_record = lc join('.', $self->check_selector, '_bimi', $self->check_domain );
161 0           my $check_domain = lc $self->check_domain;
162 0           foreach my $alt_name ( @alt_names ) {
163 0           $alt_name =~ s/^\s+//;
164 0           $alt_name =~ s/\s+$//;
165 0 0         next if ! $alt_name =~ /^dns:/;
166 0           $alt_name =~ s/^dns://;
167 0 0         return 1 if $alt_name eq $check_domain;
168 0 0         return 1 if $alt_name eq $check_full_record;
169 0 0         next if !$self->bimi_object->options->cert_subdomain_is_valid;
170 0           my $alt_name_re = quotemeta($alt_name);
171 0 0         return 1 if $check_domain =~ /\.$alt_name_re$/;
172             }
173 0           return 0;
174             }
175              
176              
177 0     0 1   sub is_self_signed($self) {
  0            
  0            
178 0 0         return if !$self->vmc_object;
179 0 0         return $self->vmc_object->x509_object->is_selfsigned ? 1 : 0;
180             }
181              
182              
183 0     0 1   sub has_valid_usage($self) {
  0            
  0            
184 0 0         return if !$self->vmc_object;
185 0           return $self->vmc_object->has_valid_usage;
186             }
187              
188 0     0     sub _build_indicator_uri($self) {
  0            
  0            
189 0 0         return if !$self->vmc_object;
190 0 0         return if !$self->vmc_object->indicator_asn;
191 0           my $uri;
192             eval{
193 0           $uri = $self->vmc_object->indicator_asn->{subjectLogo}->{direct}->{image}->[0]->{imageDetails}->{logotypeURI}->[0];
194 0           1;
195 0 0         } || do {
196 0           my $error = $@;
197 0           $self->add_error('VMC_PARSE_ERROR','Could not extract SVG from VMC');
198             };
199 0           return $uri;
200             }
201              
202 0     0     sub _build_indicator($self) {
  0            
  0            
203             # return if ! $self->_is_valid;
204 0 0         return if !$self->is_cert_valid;
205 0           my $uri = $self->indicator_uri;
206 0 0         return if !$uri;
207             ## TODO MAKE THIS BETTER
208 0 0         if ( $uri =~ /^data:image\/svg\+xml;base64,/ ) {
209 0           my ( $null, $base64 ) = split( ',', $uri );
210 0           my $data = MIME::Base64::decode($base64);
211 0           return Mail::BIMI::Indicator->new( uri => $self->uri, data => $data, bimi_object => $self->bimi_object, source => 'VMC' );
212             }
213             else {
214 0           $self->add_error('VMC_PARSE_ERROR','Could not extract SVG from VMC');
215 0           return;
216             }
217             }
218              
219              
220 0     0     sub _build_is_valid($self) {
  0            
  0            
221              
222 0 0 0       if ($self->data eq '' && $self->errors->@*) {
223             # We already have a fetch error, do not validate further
224 0           return 0;
225             }
226              
227 0 0         $self->add_error('VMC_EXPIRED','Expired') if $self->is_expired;
228 0 0         $self->add_error('VMC_VALIDATION_ERROR','Missing usage flag') if !$self->has_valid_usage;
229 0 0         $self->add_error('VMC_VALIDATION_ERROR','Invalid alt name') if !$self->is_valid_alt_name;
230 0           $self->is_cert_valid;
231              
232 0 0 0       if ( $self->chain_object && !$self->chain_object->is_valid ) {
233 0           $self->add_error_object( $self->chain_object->errors );
234             }
235              
236 0 0 0       if ( $self->indicator && !$self->indicator->is_valid ) {
237 0           $self->add_error_object( $self->indicator->errors );
238             }
239              
240 0 0         return 0 if $self->errors->@*;
241 0           $self->log_verbose('VMC is valid');
242 0           return 1;
243             }
244              
245              
246 0     0 1   sub finish($self) {
  0            
  0            
247 0 0         $self->indicator->finish if $self->indicator;
248 0           $self->_write_cache;
249             }
250              
251              
252 0     0 1   sub app_validate($self) {
  0            
  0            
253 0 0         say 'VMC Returned: '.($self->is_valid ? GREEN."\x{2713}" : BRIGHT_RED."\x{26A0}").RESET;
254 0   0       say YELLOW.' Subject '.WHITE.': '.CYAN.($self->subject//'-none-').RESET;
255 0   0       say YELLOW.' Not Before '.WHITE.': '.CYAN.($self->not_before//'-none-').RESET;
256 0   0       say YELLOW.' Not After '.WHITE.': '.CYAN.($self->not_after//'-none-').RESET;
257 0   0       say YELLOW.' Issuer '.WHITE.': '.CYAN.($self->issuer//'-none-').RESET;
258 0 0         say YELLOW.' Expired '.WHITE.': '.($self->is_expired?BRIGHT_RED.'Yes':GREEN.'No').RESET;
259 0   0       say YELLOW.' Alt Name '.WHITE.': '.CYAN.($self->alt_name//'-none-').RESET;
260 0 0         say YELLOW.' Alt Name Valid '.WHITE.': '.CYAN.($self->is_valid_alt_name?GREEN.'Yes':BRIGHT_RED.'No').RESET;
261 0 0         say YELLOW.' Has Valid Usage '.WHITE.': '.CYAN.($self->has_valid_usage?GREEN.'Yes':BRIGHT_RED.'No').RESET;
262 0 0         say YELLOW.' Cert Valid '.WHITE.': '.CYAN.($self->is_cert_valid?GREEN.'Yes':BRIGHT_RED.'No').RESET;
263 0 0         say YELLOW.' Is Valid '.WHITE.': '.CYAN.($self->is_valid?GREEN.'Yes':BRIGHT_RED.'No').RESET;
264 0 0         if ( ! $self->is_valid ) {
265 0           say "Errors:";
266 0           foreach my $error ( $self->errors->@* ) {
267 0           my $error_code = $error->code;
268 0           my $error_text = $error->description;
269 0   0       my $error_detail = $error->detail // '';
270 0           $error_detail =~ s/\n/\n /g;
271 0 0         say BRIGHT_RED." $error_code ".WHITE.': '.CYAN.$error_text.($error_detail?"\n ".$error_detail:'').RESET;
272             }
273             }
274 0 0         if ($self->chain_object){
275 0           say '';
276 0           $self->chain_object->app_validate;
277             }
278             }
279              
280             1;
281              
282             __END__
283              
284             =pod
285              
286             =encoding UTF-8
287              
288             =head1 NAME
289              
290             Mail::BIMI::VMC - Class to model a VMC
291              
292             =head1 VERSION
293              
294             version 3.20210225
295              
296             =head1 DESCRIPTION
297              
298             Class for representing, retrieving, validating, and processing a VMC Set
299              
300             =head1 INPUTS
301              
302             These values are used as inputs for lookups and verifications, they are typically set by the caller based on values found in the message being processed
303              
304             =head2 check_domain
305              
306             is=ro required
307              
308             Domain to check the alt_name against
309              
310             =head2 check_selector
311              
312             is=ro required
313              
314             Selector to check the alt_name against
315              
316             =head2 data
317              
318             is=rw
319              
320             Raw data of the VMC contents; Fetched from authority URI if not given
321              
322             =head2 uri
323              
324             is=rw
325              
326             URI of this VMC
327              
328             =head1 ATTRIBUTES
329              
330             These values are derived from lookups and verifications made based upon the input values, it is however possible to override these with other values should you wish to, for example, validate a record before it is published in DNS, or validate an Indicator which is only available locally
331              
332             =head2 cache_backend
333              
334             is=ro
335              
336             =head2 cert_list
337              
338             is=rw
339              
340             ArrayRef of individual Certificates in the chain
341              
342             =head2 chain_object
343              
344             is=rw
345              
346             Mail::BIMI::VMC::Chain object for this Chain
347              
348             =head2 errors
349              
350             is=rw
351              
352             =head2 http_client
353              
354             is=rw
355              
356             HTTP::Tiny::Paranoid (or similar) object used for HTTP operations
357              
358             =head2 indicator
359              
360             is=rw
361              
362             Mail::BIMI::Indicator object for the Indicator embedded in this VMC Set
363              
364             =head2 indicator_uri
365              
366             is=rw
367              
368             The URI of the embedded Indicator
369              
370             =head2 is_cert_valid
371              
372             is=rw
373              
374             Is this Certificate Set valid
375              
376             =head2 is_valid
377              
378             is=rw
379              
380             Is this VMC valid
381              
382             =head2 vmc_object
383              
384             is=rw
385              
386             Mail::BIMI::VMC::Cert object for this VMC Set
387              
388             =head2 warnings
389              
390             is=rw
391              
392             =head1 CONSUMES
393              
394             =over 4
395              
396             =item * L<Mail::BIMI::Role::Cacheable>
397              
398             =item * L<Mail::BIMI::Role::HasError>
399              
400             =item * L<Mail::BIMI::Role::HasError|Mail::BIMI::Role::HasHTTPClient|Mail::BIMI::Role::Cacheable>
401              
402             =item * L<Mail::BIMI::Role::HasHTTPClient>
403              
404             =back
405              
406             =head1 EXTENDS
407              
408             =over 4
409              
410             =item * L<Mail::BIMI::Base>
411              
412             =back
413              
414             =head1 METHODS
415              
416             =head2 I<cache_valid_for()>
417              
418             How long should the cache for this class be valid
419              
420             =head2 I<http_client_max_fetch_size()>
421              
422             Maximum permitted HTTP fetch
423              
424             =head2 I<subject()>
425              
426             Return the subject of the VMC
427              
428             =head2 I<not_before()>
429              
430             Return not before of the vmc
431              
432             =head2 I<not_after()>
433              
434             Return not after of the vmc
435              
436             =head2 I<issuer()>
437              
438             Return the issuer string of the VMC
439              
440             =head2 I<is_expired()>
441              
442             Return true if this VMC has expired
443              
444             =head2 I<alt_name()>
445              
446             Return the alt name string for the VMC
447              
448             =head2 I<is_valid_alt_name()>
449              
450             Return true if the VMC has a valid alt name for the domain of the current operation
451              
452             =head2 I<is_self_signed()>
453              
454             Return true if this VMC is self signed
455              
456             =head2 I<has_valid_usage()>
457              
458             Return true if this VMC has a valid usage extension for BIMI
459              
460             =head2 I<finish()>
461              
462             Finish and clean up, write cache if enabled.
463              
464             =head2 I<app_validate()>
465              
466             Output human readable validation status of this object
467              
468             =head1 REQUIRES
469              
470             =over 4
471              
472             =item * L<File::Slurp|File::Slurp>
473              
474             =item * L<MIME::Base64|MIME::Base64>
475              
476             =item * L<Mail::BIMI::Indicator|Mail::BIMI::Indicator>
477              
478             =item * L<Mail::BIMI::Prelude|Mail::BIMI::Prelude>
479              
480             =item * L<Mail::BIMI::VMC::Chain|Mail::BIMI::VMC::Chain>
481              
482             =item * L<Moose|Moose>
483              
484             =item * L<Term::ANSIColor|Term::ANSIColor>
485              
486             =back
487              
488             =head1 AUTHOR
489              
490             Marc Bradshaw <marc@marcbradshaw.net>
491              
492             =head1 COPYRIGHT AND LICENSE
493              
494             This software is copyright (c) 2020 by Marc Bradshaw.
495              
496             This is free software; you can redistribute it and/or modify it under
497             the same terms as the Perl 5 programming language system itself.
498              
499             =cut