File Coverage

blib/lib/Crypt/OpenSSL/X509.pm
Criterion Covered Total %
statement 57 61 93.4
branch 9 16 56.2
condition n/a
subroutine 13 14 92.8
pod 3 3 100.0
total 82 94 87.2


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