File Coverage

lib/Net/Domain/TMCH/CRL.pm
Criterion Covered Total %
statement 24 51 47.0
branch 0 12 0.0
condition 0 5 0.0
subroutine 8 15 53.3
pod 6 7 85.7
total 38 90 42.2


line stmt bran cond sub pod time code
1             # Copyrights 2013-2014 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 1     1   2090 use warnings;
  1         2  
  1         34  
6 1     1   6 use strict;
  1         2  
  1         43  
7              
8             package Net::Domain::TMCH::CRL;
9 1     1   6 use vars '$VERSION';
  1         1  
  1         54  
10             $VERSION = '0.17';
11              
12 1     1   6 use base 'Exporter';
  1         2  
  1         108  
13              
14 1     1   7 use Log::Report 'net-domain-smd';
  1         2  
  1         13  
15 1     1   1269 use MIME::Base64 qw(decode_base64);
  1         144750  
  1         84  
16 1     1   2087 use Convert::X509 ();
  1         87866  
  1         25  
17 1     1   8 use Scalar::Util qw(blessed);
  1         2  
  1         513  
18              
19              
20              
21 0     0 1   sub new($%) { my ($class, %args) = @_; (bless {}, $class)->init(\%args) }
  0            
22              
23             sub init($)
24 0     0 0   { my ($self, $args) = @_;
25 0 0         $self->{NDTC_source} = $args->{source} or panic;
26              
27 0   0       my $rev = $args->{revoked} || [];
28 0 0         $rev = +{ map +($_ => 1), @$rev} if ref $rev eq 'ARRAY';
29 0           $self->{NDTC_revoked} = $rev;
30 0           $self;
31             }
32              
33              
34             sub fromFile($%)
35 0     0 1   { my ($class, $fn) = (shift, shift);
36              
37 0 0         open my($fh), '<:raw', $fn
38             or fault __x"cannot read CRL file {fn}", fn => $fn;
39              
40 0           my $crl = Convert::X509::CRL->new(join '', $fh->getlines);
41 0           $class->new(source => $fn, revoked => $crl->{crl}, @_);
42             }
43              
44              
45             sub fromString($%)
46 0     0 1   { my $class = shift;
47 0           my $crl = Convert::X509::CRL->new(shift);
48 0           $class->new(source => 'string', revoked => $crl->{crl}, @_);
49             }
50              
51              
52             my $ua;
53             sub fromURI($%)
54 0     0 1   { my ($class, $uri) = (shift, shift);
55              
56 0           eval "require LWP::UserAgent";
57 0 0         $@ and error __x"need LWP::UserAgent to fetch CRL: {err}", err => $@;
58              
59 0   0       $ua ||= LWP::UserAgent->new;
60 0           my $resp = $ua->get($uri);
61 0 0         $resp->is_success
62             or error __x"could not collect CRL from {source}: {err}"
63             , source => $uri, err => $resp->status_line;
64              
65 0           my $crl = Convert::X509::CRL->new($resp->decoded_content);
66 0           $class->new(source => $uri, revoked => $crl->{crl}, @_);
67             }
68              
69             #-------------------------
70              
71              
72 0     0 1   sub source() {shift->{NDTC_source}}
73              
74             #-------------------------
75              
76              
77              
78             sub isRevoked($)
79 0     0 1   { my ($self, $cert) = @_;
80 0 0         my $serial = blessed $cert ? $cert->serial : $cert;
81 0           exists $self->{NDTC_revoked}{lc $serial};
82             }
83              
84             1;