File Coverage

blib/lib/Crypt/OpenSSL/X509.pm
Criterion Covered Total %
statement 55 59 93.2
branch 10 18 55.5
condition n/a
subroutine 12 13 92.3
pod 2 3 66.6
total 79 93 84.9


line stmt bran cond sub pod time code
1             package Crypt::OpenSSL::X509;
2              
3 4     4   264721 use warnings;
  4         44  
  4         133  
4 4     4   20 use strict;
  4         7  
  4         73  
5              
6 4     4   31 use Exporter;
  4         5  
  4         141  
7 4     4   27 use base qw(Exporter);
  4         7  
  4         662  
8              
9 4     4   1833 use Convert::ASN1;
  4         125570  
  4         2016  
10              
11             our $VERSION = '1.913';
12              
13             our @EXPORT_OK = qw(
14             FORMAT_UNDEF FORMAT_ASN1 FORMAT_TEXT FORMAT_PEM
15             FORMAT_PKCS12 FORMAT_SMIME FORMAT_ENGINE FORMAT_IISSGC OPENSSL_VERSION_NUMBER
16             );
17              
18             sub Crypt::OpenSSL::X509::has_extension_oid {
19 1     1 1 3152 my $x509 = shift;
20 1         2 my $oid = shift;
21              
22 1 50       4 if (not $Crypt::OpenSSL::X509::exts_by_oid) {
23 1         11 $Crypt::OpenSSL::X509::exts_by_oid = $x509->extensions_by_oid;
24             }
25              
26 1 50       11 return $$Crypt::OpenSSL::X509::exts_by_oid{$oid} ? 1 : 0;
27             }
28              
29             sub Crypt::OpenSSL::X509::Extension::is_critical {
30 3     3   14 my $ext = shift;
31 3         12 my $crit = $ext->critical();
32              
33 3 100       17 return $crit ? 1 : 0;
34             }
35              
36             # return a hash for the values of keyUsage or nsCertType
37             sub Crypt::OpenSSL::X509::Extension::hash_bit_string {
38 1     1   3 my $ext = shift;
39              
40 1         17 my @bits = split(//, $ext->bit_string);
41 1         4 my $len = @bits;
42              
43 1         3 my %bit_str_hash = ();
44              
45 1 50       4 if ($len == 9) { # bits for keyUsage
    0          
46              
47 1         21 %bit_str_hash = (
48             'Digital Signature' => $bits[0],
49             'Non Repudiation' => $bits[1],
50             'Key Encipherment' => $bits[2],
51             'Data Encipherment' => $bits[3],
52             'Key Agreement' => $bits[4],
53             'Certificate Sign' => $bits[5],
54             'CRL Sign' => $bits[6],
55             'Encipher Only' => $bits[7],
56             'Decipher Only' => $bits[8],);
57              
58             } elsif ($len == 8) { #bits for nsCertType
59              
60 0         0 %bit_str_hash = (
61             'SSL Client' => $bits[0],
62             'SSL Server' => $bits[1],
63             'S/MIME' => $bits[2],
64             'Object Signing' => $bits[3],
65             'Unused' => $bits[4],
66             'SSL CA' => $bits[5],
67             'S/MIME CA' => $bits[6],
68             'Object Signing CA' => $bits[7],);
69             }
70              
71 1         12 return %bit_str_hash;
72             }
73              
74             sub Crypt::OpenSSL::X509::Extension::extKeyUsage {
75 0     0   0 my $ext = shift;
76              
77 0         0 my @vals = split(/ /, $ext->extendedKeyUsage);
78              
79 0         0 return @vals;
80             }
81              
82             sub Crypt::OpenSSL::X509::is_selfsigned {
83 1     1 1 3520 my $x509 = shift;
84              
85 1         32 return $x509->subject eq $x509->issuer;
86             }
87              
88             sub Crypt::OpenSSL::X509::subjectaltname {
89 8     8 0 6935 my $x509 = shift;
90              
91 8         18 my $SUBJECT_ALT_NAME_OID = '2.5.29.17';
92 8         12 my $ext;
93 8         14 eval {
94             # extensions_by_oid croaks of no extensions found
95             # we don't care we will return an empty array
96 8         173 $ext = $x509->extensions_by_oid();
97             };
98              
99             # Determine whether the SubjectAltName exist
100 8 100       30 if (! defined ${$ext}{$SUBJECT_ALT_NAME_OID}) {
  8         32  
101             # Simply return a reference to an empty array if it does not exist
102 5         10 my @tmp = ();
103 5         27 return \@tmp;
104             }
105              
106 3         7 my $pdu = ${$ext}{$SUBJECT_ALT_NAME_OID}->value();
  3         55  
107              
108             # remove leading '#' from the value returned
109 3         34 $pdu =~ s/^#//g;
110              
111 3         28 my $bin_data = join '', pack 'H*', $pdu;
112 3         23 my $asn = Convert::ASN1->new();
113              
114 3         156 my $ok = $asn->prepare(q<
115             AnotherName ::= SEQUENCE {
116             type OBJECT IDENTIFIER,
117             value [0] EXPLICIT ANY } --DEFINED BY type-id }
118              
119             EDIPartyName ::= SEQUENCE {
120             nameAssigner [0] DirectoryString OPTIONAL,
121             partyName [1] DirectoryString }
122              
123             -- Directory string type --
124              
125             DirectoryString ::= CHOICE {
126             teletexString TeletexString, --(SIZE (1..MAX)),
127             printableString PrintableString, --(SIZE (1..MAX)),
128             bmpString BMPString, --(SIZE (1..MAX)),
129             universalString UniversalString, --(SIZE (1..MAX)),
130             utf8String UTF8String, --(SIZE (1..MAX)),
131             ia5String IA5String --added for EmailAddress
132             }
133              
134             AttributeType ::= OBJECT IDENTIFIER
135              
136             AttributeValue ::= DirectoryString --ANY
137              
138             AttributeTypeAndValue ::= SEQUENCE {
139             type AttributeType,
140             value AttributeValue
141             }
142              
143             -- naming data types --
144              
145             Name ::= CHOICE { -- only one possibility for now
146             rdnSequence RDNSequence
147             }
148              
149             RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
150              
151             DistinguishedName ::= RDNSequence
152              
153             RelativeDistinguishedName ::=
154             SET OF AttributeTypeAndValue --SET SIZE (1 .. MAX) OF
155              
156             SubjectAltName ::= GeneralNames
157              
158             GeneralNames ::= SEQUENCE OF GeneralName
159              
160             GeneralName ::= CHOICE {
161             rfc822Name [1] IA5String,
162             dNSName [2] IA5String,
163             x400Address [3] ANY, --ORAddress,
164             directoryName [4] Name,
165             ediPartyName [5] EDIPartyName,
166             uniformResourceIdentifier [6] IA5String,
167             iPAddress [7] OCTET STRING,
168             registeredID [8] OBJECT IDENTIFIER
169             }
170              
171             >);
172 3 50       34736 die '*** Could not prepare definition: '.$asn->error()
173             if !$ok;
174              
175             # This is an important bit - if you don't do the find the decode
176             # will randomly fail/succeed. This is required to work
177 3 50       22 my $asn_node = $asn->find('SubjectAltName')
178             or die $asn->error;
179              
180 3 50       73 my $san = $asn_node->decode($bin_data)
181             or die 'Unable to decode SubjectAltName: '.$asn_node->error;
182              
183 3         691 return $san;
184             }
185              
186 4     4   49 use XSLoader;
  4         8  
  4         256  
187             XSLoader::load 'Crypt::OpenSSL::X509', $VERSION;
188              
189             END {
190 4     4   16419 __PACKAGE__->__X509_cleanup;
191             }
192              
193             1;
194              
195             __END__