File Coverage

blib/lib/Mail/BIMI/VMC/Cert.pm
Criterion Covered Total %
statement 23 103 22.3
branch 0 32 0.0
condition 0 3 0.0
subroutine 8 17 47.0
pod 3 3 100.0
total 34 158 21.5


line stmt bran cond sub pod time code
1             package Mail::BIMI::VMC::Cert;
2             # ABSTRACT: Class to model a VMC Cert
3             our $VERSION = '3.20210512'; # VERSION
4 29     29   437 use 5.20.0;
  29         118  
5 29     29   185 use Moose;
  29         63  
  29         193  
6 29     29   193690 use Mail::BIMI::Prelude;
  29         88  
  29         236  
7 29     29   26355 use Convert::ASN1;
  29         909223  
  29         2006  
8 29     29   16958 use Crypt::OpenSSL::X509 1.812;
  29         117093  
  29         2454  
9 29     29   15157 use Crypt::OpenSSL::Verify 0.20;
  29         24664  
  29         1103  
10 29     29   231 use File::Slurp qw{ read_file write_file };
  29         73  
  29         1964  
11 29     29   262 use File::Temp;
  29         74  
  29         39057  
12              
13             extends 'Mail::BIMI::Base';
14             with(
15             'Mail::BIMI::Role::Data',
16             'Mail::BIMI::Role::HasError',
17             );
18             has chain => ( is => 'rw', isa => 'Mail::BIMI::VMC::Chain', required => 1, weak_ref => 1,
19             documentation => 'Back reference to the chain' );
20             has ascii_lines => ( is => 'rw', isa => 'ArrayRef', required => 1,
21             documentation => 'inputs: Raw data of the Cert contents', );
22             has x509_object => ( is => 'rw', isa => 'Maybe[Crypt::OpenSSL::X509]', lazy => 1, builder => '_build_x509_object',
23             documentation => 'Crypt::OpenSSL::X509 object for the Certificate' );
24             has verifier => ( is => 'rw', isa => 'Crypt::OpenSSL::Verify', lazy => 1, builder => '_build_verifier',
25             documentation => 'Crypt::OpenSSL::Verify object for the Certificate' );
26             has is_valid_to_root => ( is => 'rw',
27             documentation => 'Could we validate this certificate to the root certs, set by Mail::BIMI::VMC::Chain->is_valid' );
28             has filename => ( is => 'rw', lazy => 1, builder => '_build_filename',
29             documentation => 'Filename of temporary file containing the cert' );
30             has _delete_file_on_destroy => ( is => 'rw', lazy => 1, default => sub{return 0} );
31             has is_valid => ( is => 'rw', lazy => 1, builder => '_build_is_valid',
32             documentation => 'Is this a valid Cert?' );
33             has indicator_asn => ( is => 'rw', lazy => 1, builder => '_build_indicator_asn',
34             documentation => 'Parsed ASN data for the embedded Indicator' );
35             has index => ( is => 'rw', required => 1,
36             documentation => 'Index of this certificate in the chain' );
37             has validated_by => ( is => 'rw',
38             documentation => 'Root and/or intermediate certificate in the chain used to verify this certificate' );
39             has validated_by_id => ( is => 'rw',
40             documentation => 'Index of cert which validated this cert' );
41              
42              
43             sub DESTROY {
44 0     0     my ($self) = @_;
45 0 0         return unless $self->{_delete_file_on_destroy};
46 0 0 0       if ( $self->{filename} && -f $self->{filename} ) {
47 0 0         unlink $self->{filename} or warn "Unable to unlink temporary cert file: $!";
48             }
49             }
50              
51 0     0     sub _build_is_valid($self) {
  0            
  0            
52 0           $self->x509_object; # trigger object parse
53 0 0         return 0 if $self->errors->@*;
54 0           return 1;
55             }
56              
57 0     0     sub _build_indicator_asn($self) {
  0            
  0            
58 0 0         return if !$self->x509_object;
59 0           my $exts = eval{ $self->x509_object->extensions_by_oid() };
  0            
60 0 0         return if !$exts;
61 0 0         return if !exists $exts->{&LOGOTYPE_OID};
62 0           my $indhex = $exts->{&LOGOTYPE_OID}->value;
63 0           $indhex =~ s/^#//;
64 0           my $indicator = pack("H*",$indhex);
65 0           my $asn = Convert::ASN1->new;
66 0           $asn->prepare_file($self->get_file_name('asn1.txt'));
67 0           my $decoder = $asn->find('LogotypeExtn');
68 0 0         die $asn->error if $asn->error;
69 0           my $decoded = $decoder->decode($indicator);
70 0 0         if ( $decoder->error ) {
71 0           $self->add_error('VMC_PARSE_ERROR',$decoder->error);
72 0           return;
73             }
74              
75             #my $image_details = $decoded->{subjectLogo}->{direct}->{image}->[0]->{imageDetails};
76             #my $mime_type = $image_details->{mediaType};
77             #my $logo_hash = $image_details->{logotypeHash}->[0];
78 0           return $decoded;
79             }
80              
81 0     0     sub _build_x509_object($self) {
  0            
  0            
82 0           my $cert;
83             eval{
84 0           $cert = Crypt::OpenSSL::X509->new_from_string(join("\n",$self->ascii_lines->@*));
85 0           1;
86 0 0         } || do {
87 0           my $error = $@;
88 0           chomp $error;
89 0           $error =~ s/\. at .*$//;
90 0           $self->add_error('VMC_PARSE_ERROR',$error);
91 0           return;
92             };
93 0           return $cert;
94             }
95              
96 0     0     sub _build_verifier($self) {
  0            
  0            
97 0           return Crypt::OpenSSL::Verify->new($self->filename,{noCApath=>1});
98             }
99              
100              
101 0     0 1   sub is_expired($self) {
  0            
  0            
102 0 0         return 0 if !$self->x509_object;
103 0           my $seconds = 0;
104 0 0         if ($self->x509_object->checkend($seconds)) {
105 0           return 1;
106             }
107 0           return 0;
108             }
109              
110              
111 0     0 1   sub has_valid_usage($self) {
  0            
  0            
112 0 0         return if !$self->x509_object;
113 0           my $exts = eval{ $self->x509_object->extensions_by_oid() };
  0            
114 0 0         return if !$exts;
115 0           my $extended_usage = $exts->{'2.5.29.37'};
116 0 0         return if !$extended_usage;
117 0           my $extended_usage_string = $extended_usage->to_string;
118 0 0         return 1 if $extended_usage_string eq USAGE_OID;
119 0           return 0;
120             }
121              
122              
123 0     0 1   sub full_chain($self) {
  0            
  0            
124 0           return join("\n",$self->ascii_lines->@*,$self->validated_by);
125             }
126              
127 0     0     sub _build_filename($self) {
  0            
  0            
128 0           my $temp_fh = File::Temp->new(UNLINK=>0);
129 0           my $temp_name = $temp_fh->filename;
130 0           close $temp_fh;
131 0           write_file($temp_name,$self->full_chain);
132 0           $self->_delete_file_on_destroy(1);
133 0           return $temp_name;
134             }
135              
136             1;
137              
138             __END__
139              
140             =pod
141              
142             =encoding UTF-8
143              
144             =head1 NAME
145              
146             Mail::BIMI::VMC::Cert - Class to model a VMC Cert
147              
148             =head1 VERSION
149              
150             version 3.20210512
151              
152             =head1 DESCRIPTION
153              
154             Class for representing, retrieving, validating, and processing a VMC Certificate
155              
156             =head1 INPUTS
157              
158             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
159              
160             =head2 ascii_lines
161              
162             is=rw required
163              
164             Raw data of the Cert contents
165              
166             =head1 ATTRIBUTES
167              
168             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
169              
170             =head2 chain
171              
172             is=rw required
173              
174             Back reference to the chain
175              
176             =head2 errors
177              
178             is=rw
179              
180             =head2 filename
181              
182             is=rw
183              
184             Filename of temporary file containing the cert
185              
186             =head2 index
187              
188             is=rw required
189              
190             Index of this certificate in the chain
191              
192             =head2 indicator_asn
193              
194             is=rw
195              
196             Parsed ASN data for the embedded Indicator
197              
198             =head2 is_valid
199              
200             is=rw
201              
202             Is this a valid Cert?
203              
204             =head2 is_valid_to_root
205              
206             is=rw
207              
208             Could we validate this certificate to the root certs, set by Mail::BIMI::VMC::Chain->is_valid
209              
210             =head2 validated_by
211              
212             is=rw
213              
214             Root and/or intermediate certificate in the chain used to verify this certificate
215              
216             =head2 validated_by_id
217              
218             is=rw
219              
220             Index of cert which validated this cert
221              
222             =head2 verifier
223              
224             is=rw
225              
226             Crypt::OpenSSL::Verify object for the Certificate
227              
228             =head2 warnings
229              
230             is=rw
231              
232             =head2 x509_object
233              
234             is=rw
235              
236             Crypt::OpenSSL::X509 object for the Certificate
237              
238             =head1 CONSUMES
239              
240             =over 4
241              
242             =item * L<Mail::BIMI::Role::Data>
243              
244             =item * L<Mail::BIMI::Role::Data|Mail::BIMI::Role::HasError>
245              
246             =item * L<Mail::BIMI::Role::HasError>
247              
248             =back
249              
250             =head1 EXTENDS
251              
252             =over 4
253              
254             =item * L<Mail::BIMI::Base>
255              
256             =back
257              
258             =head1 METHODS
259              
260             =head2 I<is_expired()>
261              
262             Return true if this cert has expired
263              
264             =head2 I<has_valid_usage()>
265              
266             Return true if this VMC has a valid usage extension for BIMI
267              
268             =head2 I<full_chain()>
269              
270             The full chain of this certificate as verified to root
271              
272             =head1 REQUIRES
273              
274             =over 4
275              
276             =item * L<Convert::ASN1|Convert::ASN1>
277              
278             =item * L<Crypt::OpenSSL::Verify|Crypt::OpenSSL::Verify>
279              
280             =item * L<Crypt::OpenSSL::X509|Crypt::OpenSSL::X509>
281              
282             =item * L<File::Slurp|File::Slurp>
283              
284             =item * L<File::Temp|File::Temp>
285              
286             =item * L<Mail::BIMI::Prelude|Mail::BIMI::Prelude>
287              
288             =item * L<Moose|Moose>
289              
290             =back
291              
292             =head1 AUTHOR
293              
294             Marc Bradshaw <marc@marcbradshaw.net>
295              
296             =head1 COPYRIGHT AND LICENSE
297              
298             This software is copyright (c) 2020 by Marc Bradshaw.
299              
300             This is free software; you can redistribute it and/or modify it under
301             the same terms as the Perl 5 programming language system itself.
302              
303             =cut