File Coverage

blib/lib/Crypt/X509.pm
Criterion Covered Total %
statement 406 528 76.8
branch 93 152 61.1
condition 5 6 83.3
subroutine 54 65 83.0
pod 52 55 94.5
total 610 806 75.6


line stmt bran cond sub pod time code
1             package Crypt::X509;
2 1     1   123430 use Carp;
  1         2  
  1         65  
3 1     1   6 use strict;
  1         2  
  1         21  
4 1     1   4 use warnings;
  1         2  
  1         44  
5 1     1   535 use Convert::ASN1 qw(:io :debug);
  1         37604  
  1         5881  
6             require Exporter;
7             our @ISA = qw(Exporter);
8             our %EXPORT_TAGS = ( 'all' => [qw()] );
9             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
10             #our @EXPORT = qw(error new not_before not_after serial);
11             our $VERSION = '0.54';
12             my $parser = undef;
13             my $asn = undef;
14             my $error = undef;
15             our %oid2enchash = (
16             '1.2.840.113549.1.1.1' => { 'enc' => 'RSA' },
17             '1.2.840.113549.1.1.2' => { 'enc' => 'RSA', 'hash' => 'MD2' },
18             '1.2.840.113549.1.1.3' => { 'enc' => 'RSA', 'hash' => 'MD4' },
19             '1.2.840.113549.1.1.4' => { 'enc' => 'RSA', 'hash' => 'MD5' },
20             '1.2.840.113549.1.1.5' => { 'enc' => 'RSA', 'hash' => 'SHA1' },
21             '1.2.840.113549.1.1.6' => { 'enc' => 'OAEP' },
22             '1.2.840.113549.1.1.11' => { 'enc' => 'RSA', 'hash' => 'SHA256' },
23             '1.2.840.113549.1.1.12' => { 'enc' => 'RSA', 'hash' => 'SHA384' },
24             '1.2.840.113549.1.1.13' => { 'enc' => 'RSA', 'hash' => 'SHA512' },
25             '1.2.840.113549.1.1.14' => { 'enc' => 'RSA', 'hash' => 'SHA224' },
26             '1.2.840.10045.2.1' => { 'enc' => 'EC' },
27             );
28              
29             our %oid2attr = (
30             "2.5.4.3" => "CN",
31             "2.5.4.4" => "SN",
32             "2.5.4.42" => "GN",
33             "2.5.4.5" => "serialNumber",
34             "2.5.4.6" => "C",
35             "2.5.4.7" => "L",
36             "2.5.4.8" => "ST",
37             '2.5.4.9' => 'streetAddress',
38             "2.5.4.10" => "O",
39             "2.5.4.11" => "OU",
40             "1.2.840.113549.1.9.1" => "emailAddress",
41             '1.2.840.113549.1.9.2' => 'unstructuredName',
42             "0.9.2342.19200300.100.1.1" => "UID",
43             "0.9.2342.19200300.100.1.25" => "DC",
44             "0.2.262.1.10.7.20" => "nameDistinguisher",
45             '2.5.4.12' => 'title',
46             '2.5.4.13' => 'description',
47             '2.5.4.14' => 'searchGuide',
48             '2.5.4.15' => 'businessCategory',
49             '2.5.4.16' => 'postalAddress',
50             '2.5.4.17' => 'postalCode',
51             '2.5.4.18' => 'postOfficeBox',
52             '2.5.4.19' => 'physicalDeliveryOfficeName',
53             '2.5.4.20' => 'telephoneNumber',
54             '2.5.4.23' => 'facsimileTelephoneNumber',
55             '2.5.4.41' => 'name',
56             '2.5.4.43' => 'initials',
57             '2.5.4.44' => 'generationQualifier',
58             '2.5.4.45' => 'uniqueIdentifier',
59             '2.5.4.46' => 'dnQualifier',
60             '2.5.4.51' => 'houseIdentifier',
61             '2.5.4.65' => 'pseudonym',
62             );
63              
64             =head1 NAME
65              
66             Crypt::X509 - Parse a X.509 certificate
67              
68             =head1 SYNOPSIS
69              
70             use Crypt::X509;
71              
72             $decoded = Crypt::X509->new( cert => $cert );
73              
74             $subject_email = $decoded->subject_email;
75             print "do not use after: ".gmtime($decoded->not_after)." GMT\n";
76              
77             =head1 REQUIRES
78              
79             Convert::ASN1
80              
81             =head1 DESCRIPTION
82              
83             B parses X.509 certificates. Methods are provided for accessing most
84             certificate elements.
85              
86             It is based on the generic ASN.1 module by Graham Barr, on the F
87             example by Norbert Klasen and contributions on the perl-ldap-dev-Mailinglist
88             by Chriss Ridd.
89              
90             =head1 CONSTRUCTOR
91              
92             =head2 new ( OPTIONS )
93              
94             Creates and returns a parsed X.509 certificate hash, containing the parsed
95             contents. The data is organised as specified in RFC 2459.
96             By default only the first ASN.1 Layer is decoded. Nested decoding
97             is done automagically through the data access methods.
98              
99             =over 4
100              
101             =item cert =E $certificate
102              
103             A variable containing the DER formatted certificate to be parsed
104             (eg. as stored in C attribute in an
105             LDAP-directory).
106              
107             =back
108              
109             use Crypt::X509;
110             use Data::Dumper;
111              
112             $decoded= Crypt::X509->new(cert => $cert);
113              
114             print Dumper($decoded);
115              
116             =cut back
117              
118             sub new {
119 11     11 1 2927 my ( $class, %args ) = @_;
120 11 100 100     67 if ( !defined($parser) || $parser->error ) {
121 2         12 $parser = _init();
122             }
123 11         89 my $self = $parser->decode( $args{'cert'} );
124 11         47915 $self->{"_error"} = $parser->error;
125 11         57 bless( $self, $class );
126 11         106 return $self;
127             }
128              
129             =head1 METHODS
130              
131             =head2 error
132              
133             Returns the last error from parsing, C when no error occured.
134             This error is updated on deeper parsing with the data access methods.
135              
136              
137             $decoded= Crypt::X509->new(cert => $cert);
138             if ($decoded->error) {
139             warn "Error on parsing Certificate:".$decoded->error;
140             }
141              
142             =cut back
143              
144             sub error {
145 10     10 1 1141 my $self = shift;
146 10         60 return $self->{"_error"};
147             }
148              
149             =head1 DATA ACCESS METHODS
150              
151             You can access all parsed data directly from the returned hash. For convenience
152             the following methods have been implemented to give quick access to the most-used
153             certificate attributes.
154              
155             =head2 version
156              
157             Returns the certificate's version as an integer. NOTE that version is defined as
158             an Integer where 0 = v1, 1 = v2, and 2 = v3.
159              
160             =cut back
161              
162             sub version {
163 0     0 1 0 my $self = shift;
164 0         0 return $self->{tbsCertificate}{version};
165             }
166              
167             =head2 version_string
168              
169             Returns the certificate's version as a string value.
170              
171             =cut back
172              
173             sub version_string {
174 1     1 1 3 my $self = shift;
175 1         3 my $v = $self->{tbsCertificate}{version};
176 1 50       5 return "v1" if $v == 0;
177 1 50       5 return "v2" if $v == 1;
178 1 50       7 return "v3" if $v == 2;
179             }
180              
181             =head2 serial
182              
183             returns the serial number (integer or Math::BigInt Object, that gets automagic
184             evaluated in scalar context) from the certificate
185              
186              
187             $decoded= Crypt::X509->new(cert => $cert);
188             print "Certificate has serial number:".$decoded->serial."\n";
189              
190             =cut back
191              
192             sub serial {
193 0     0 1 0 my $self = shift;
194 0         0 return $self->{tbsCertificate}{serialNumber};
195             }
196              
197             =head2 not_before
198              
199             returns the GMT-timestamp of the certificate's beginning date of validity.
200             If the Certificate holds this Entry in utcTime, it is guaranteed by the
201             RFC to been correct.
202              
203             As utcTime is limited to 32-bit values (like unix-timestamps) newer certificates
204             hold the timesamps as "generalTime"-entries. B
205             are not well defined in the RFC and
206             are returned by this module unmodified>, if no utcTime-entry is found.
207              
208              
209             $decoded= Crypt::X509->new(cert => $cert);
210             if ($decoded->notBefore < time()) {
211             warn "Certificate: not yet valid!";
212             }
213              
214             =cut back
215              
216             sub not_before {
217 0     0 1 0 my $self = shift;
218 0 0       0 if ( $self->{tbsCertificate}{validity}{notBefore}{utcTime} ) {
    0          
219 0         0 return $self->{tbsCertificate}{validity}{notBefore}{utcTime};
220             } elsif ( $self->{tbsCertificate}{validity}{notBefore}{generalTime} ) {
221 0         0 return $self->{tbsCertificate}{validity}{notBefore}{generalTime};
222             } else {
223 0         0 return undef;
224             }
225             }
226              
227             =head2 not_after
228              
229             returns the GMT-timestamp of the certificate's ending date of validity.
230             If the Certificate holds this Entry in utcTime, it is guaranteed by the
231             RFC to been correct.
232              
233             As utcTime is limited to 32-bit values (like unix-timestamps) newer certificates
234             hold the timesamps as "generalTime"-entries. B
235             are not well defined in the RFC and
236             are returned by this module unmodified>, if no utcTime-entry is found.
237              
238              
239             $decoded= Crypt::X509->new(cert => $cert);
240             print "Certificate expires on ".gmtime($decoded->not_after)." GMT\n";
241              
242             =cut back
243              
244             sub not_after {
245 4     4 1 29 my $self = shift;
246 4 100       18 if ( $self->{tbsCertificate}{validity}{notAfter}{utcTime} ) {
    50          
247 2         11 return $self->{tbsCertificate}{validity}{notAfter}{utcTime};
248             } elsif ( $self->{tbsCertificate}{validity}{notAfter}{generalTime} ) {
249 2         15 return $self->{tbsCertificate}{validity}{notAfter}{generalTime};
250             } else {
251 0         0 return undef;
252             }
253             }
254              
255             =head2 signature
256              
257             Return's the certificate's signature in binary DER format.
258              
259             =cut back
260              
261             sub signature {
262 1     1 1 3 my $self = shift;
263 1         6 return $self->{signature}[0];
264             }
265              
266             =head2 pubkey
267              
268             Returns the certificate's public key in binary DER format.
269              
270             =cut back
271              
272             sub pubkey {
273 1     1 1 3 my $self = shift;
274 1         6 return $self->{tbsCertificate}{subjectPublicKeyInfo}{subjectPublicKey}[0];
275             }
276              
277             =head2 pubkey_size
278              
279             Returns the certificate's public key size.
280              
281             =cut back
282              
283             sub pubkey_size {
284 0     0 1 0 my $self = shift;
285 0         0 return $self->{tbsCertificate}{subjectPublicKeyInfo}{subjectPublicKey}[1];
286             }
287              
288             =head2 pubkey_algorithm
289              
290             Returns the algorithm as OID string which the public key was created with.
291              
292             =cut back
293              
294             sub pubkey_algorithm {
295 1     1 1 3 my $self = shift;
296 1         5 return $self->{tbsCertificate}{subjectPublicKeyInfo}{algorithm}{algorithm};
297             }
298              
299             =head2 PubKeyAlg
300              
301             returns the subject public key encryption algorithm (e.g. 'RSA') as string.
302              
303             $decoded= Crypt::X509->new(cert => $cert);
304             print "Certificate public key is encrypted with:".$decoded->PubKeyAlg."\n";
305              
306             Example Output: Certificate public key is encrypted with: RSA
307              
308             =cut back
309              
310             sub PubKeyAlg {
311 2     2 1 4 my $self = shift;
312 2         20 return $oid2enchash{ $self->{tbsCertificate}{subjectPublicKeyInfo}{algorithm}{algorithm} }->{'enc'};
313             }
314              
315             =head2 pubkey_components
316              
317             If this certificate contains an RSA key, this function returns a
318             hashref { modulus => $m, exponent => $e) from that key; each value in
319             the hash will be an integer scalar or a Math::BigInt object.
320              
321             For other pubkey types, it returns undef (implementations welcome!).
322              
323             =cut back
324              
325             sub pubkey_components {
326 2     2 1 23927 my $self = shift;
327 2 50       10 if ($self->PubKeyAlg() eq 'RSA') {
328 2         8 my $parser = _init('RSAPubKeyInfo');
329 2         11 my $values = $parser->decode($self->{tbsCertificate}{subjectPublicKeyInfo}{subjectPublicKey}[0]);
330 2         150656 return $values;
331             } else {
332 0         0 return undef;
333             }
334             }
335              
336             =head2 sig_algorithm
337              
338             Returns the certificate's signature algorithm as OID string
339              
340             $decoded= Crypt::X509->new(cert => $cert);
341             print "Certificate signature is encrypted with:".$decoded->sig_algorithm."\n";>
342              
343             Example Output: Certificate signature is encrypted with: 1.2.840.113549.1.1.5
344              
345             =cut back
346              
347             sub sig_algorithm {
348 1     1 1 2 my $self = shift;
349 1         6 return $self->{tbsCertificate}{signature}{algorithm};
350             }
351              
352             =head2 SigEncAlg
353              
354             returns the signature encryption algorithm (e.g. 'RSA') as string.
355              
356             $decoded= Crypt::X509->new(cert => $cert);
357             print "Certificate signature is encrypted with:".$decoded->SigEncAlg."\n";
358              
359             Example Output: Certificate signature is encrypted with: RSA
360              
361             =cut back
362              
363             sub SigEncAlg {
364 0     0 1 0 my $self = shift;
365 0         0 return $oid2enchash{ $self->{'signatureAlgorithm'}->{'algorithm'} }->{'enc'};
366             }
367              
368             =head2 SigHashAlg
369              
370             returns the signature hashing algorithm (e.g. 'SHA1') as string.
371              
372             $decoded= Crypt::X509->new(cert => $cert);
373             print "Certificate signature is hashed with:".$decoded->SigHashAlg."\n";
374              
375             Example Output: Certificate signature is encrypted with: SHA1
376              
377             =cut back
378              
379             sub SigHashAlg {
380 1     1 1 3 my $self = shift;
381 1         7 return $oid2enchash{ $self->{'signatureAlgorithm'}->{'algorithm'} }->{'hash'};
382             }
383             #########################################################################
384             # accessors - subject
385             #########################################################################
386              
387             =head2 Subject
388              
389             returns a pointer to an array of strings containing subject nameparts of the
390             certificate. Attributenames for the most common Attributes are translated
391             from the OID-Numbers, unknown numbers are output verbatim.
392              
393             $decoded= Convert::ASN1::X509->new($cert);
394             print "DN for this Certificate is:".join(',',@{$decoded->Subject})."\n";
395              
396             =cut back
397             sub Subject {
398 3     3 1 10 my $self = shift;
399 3         6 my ( $i, $type );
400 3         8 my $subjrdn = $self->{'tbsCertificate'}->{'subject'}->{'rdnSequence'};
401 3         7 $self->{'tbsCertificate'}->{'subject'}->{'dn'} = [];
402 3         7 my $subjdn = $self->{'tbsCertificate'}->{'subject'}->{'dn'};
403 3         5 foreach my $subj ( @{$subjrdn} ) {
  3         8  
404 11         15 foreach my $i ( @{$subj} ) {
  11         21  
405 12 50       26 if ( $oid2attr{ $i->{'type'} } ) {
406 12         19 $type = $oid2attr{ $i->{'type'} };
407             } else {
408 0         0 $type = $i->{'type'};
409             }
410 12         17 my @key = keys( %{ $i->{'value'} } );
  12         29  
411 12         16 push @{$subjdn}, $type . "=" . $i->{'value'}->{ $key[0] };
  12         41  
412             }
413             }
414 3         18 return $subjdn;
415             }
416              
417              
418             sub SubjectRaw {
419              
420 1     1 0 3 my $self = shift;
421 1         2 my @subject;
422 1         2 foreach my $rdn (@{$self->{'tbsCertificate'}->{'subject'}->{'rdnSequence'}}) {
  1         5  
423             my @sequence = map {
424 4         7 $_->{format} = (keys %{$_->{value}})[0];
  4         10  
425 4         7 $_->{value} = (values %{$_->{value}})[0];
  4         8  
426 4         11 $_;
427 4         6 } @{$rdn};
  4         6  
428 4 50       10 if (scalar @sequence > 1) {
429 0         0 push @subject, \@sequence;
430             } else {
431 4         9 push @subject, $sequence[0];
432             }
433             }
434 1         11 return \@subject;
435             }
436              
437             sub _subject_part {
438 5     5   8 my $self = shift;
439 5         8 my $oid = shift;
440 5         11 my $subjrdn = $self->{'tbsCertificate'}->{'subject'}->{'rdnSequence'};
441 5         7 foreach my $subj ( @{$subjrdn} ) {
  5         11  
442 14         16 foreach my $i ( @{$subj} ) {
  14         22  
443 14 100       32 if ( $i->{'type'} eq $oid ) {
444 3         4 my @key = keys( %{ $i->{'value'} } );
  3         10  
445 3         15 return $i->{'value'}->{ $key[0] };
446             }
447             }
448             }
449 2         9 return undef;
450             }
451              
452             =head2 subject_country
453              
454             Returns the string value for subject's country (= the value with the
455             OID 2.5.4.6 or in DN Syntax everything after C).
456             Only the first entry is returned. C if subject contains no country attribute.
457              
458             =cut back
459              
460             sub subject_country {
461 1     1 1 2 my $self = shift;
462 1         4 return _subject_part( $self, '2.5.4.6' );
463             }
464              
465             =head2 subject_locality
466              
467             Returns the string value for subject's locality (= the value with the
468             OID 2.5.4.7 or in DN Syntax everything after C).
469             Only the first entry is returned. C if subject contains no locality attribute.
470              
471             =cut back
472              
473             sub subject_locality {
474 0     0 1 0 my $self = shift;
475 0         0 return _subject_part( $self, '2.5.4.7' );
476             }
477              
478             =head2 subject_state
479              
480             Returns the string value for subject's state or province (= the value with the
481             OID 2.5.4.8 or in DN Syntax everything after C).
482             Only the first entry is returned. C if subject contains no state attribute.
483              
484             =cut back
485              
486             sub subject_state {
487 1     1 1 2 my $self = shift;
488 1         4 return _subject_part( $self, '2.5.4.8' );
489             }
490              
491             =head2 subject_org
492              
493             Returns the string value for subject's organization (= the value with the
494             OID 2.5.4.10 or in DN Syntax everything after C).
495             Only the first entry is returned. C if subject contains no organization attribute.
496              
497             =cut back
498              
499             sub subject_org {
500 1     1 1 14 my $self = shift;
501 1         7 return _subject_part( $self, '2.5.4.10' );
502             }
503              
504             =head2 subject_ou
505              
506             Returns the string value for subject's organizational unit (= the value with the
507             OID 2.5.4.11 or in DN Syntax everything after C).
508             Only the first entry is returned. C if subject contains no organization attribute.
509              
510             =cut back
511              
512             sub subject_ou {
513 1     1 1 3 my $self = shift;
514 1         4 return _subject_part( $self, '2.5.4.11' );
515             }
516              
517             =head2 subject_cn
518              
519             Returns the string value for subject's common name (= the value with the
520             OID 2.5.4.3 or in DN Syntax everything after C).
521             Only the first entry is returned. C if subject contains no common name attribute.
522              
523             =cut back
524              
525             sub subject_cn {
526 0     0 1 0 my $self = shift;
527 0         0 return _subject_part( $self, '2.5.4.3' );
528             }
529              
530             =head2 subject_email
531              
532             Returns the string value for subject's email address (= the value with the
533             OID 1.2.840.113549.1.9.1 or in DN Syntax everything after C).
534             Only the first entry is returned. C if subject contains no email attribute.
535              
536             =cut back
537              
538             sub subject_email {
539 1     1 1 14 my $self = shift;
540 1         4 return _subject_part( $self, '1.2.840.113549.1.9.1' );
541             }
542             #########################################################################
543             # accessors - issuer
544             #########################################################################
545              
546             =head2 Issuer
547              
548             returns a pointer to an array of strings building the DN of the certificate
549             issuer (= the DN of the CA). Attributenames for the most common Attributes
550             are translated from the OID-Numbers, unknown numbers are output verbatim.
551              
552             $decoded= Crypt::X509->new($cert);
553             print "Certificate was issued by:".join(',',@{$decoded->Issuer})."\n";
554              
555             =cut back
556             sub Issuer {
557 3     3 1 9 my $self = shift;
558 3         5 my ( $i, $type );
559 3         9 my $issuerdn = $self->{'tbsCertificate'}->{'issuer'}->{'rdnSequence'};
560 3         8 $self->{'tbsCertificate'}->{'issuer'}->{'dn'} = [];
561 3         8 my $issuedn = $self->{'tbsCertificate'}->{'issuer'}->{'dn'};
562 3         4 foreach my $issue ( @{$issuerdn} ) {
  3         8  
563 11         15 foreach my $i ( @{$issue} ) {
  11         17  
564 12 50       30 if ( $oid2attr{ $i->{'type'} } ) {
565 12         22 $type = $oid2attr{ $i->{'type'} };
566             } else {
567 0         0 $type = $i->{'type'};
568             }
569 12         14 my @key = keys( %{ $i->{'value'} } );
  12         32  
570 12         18 push @{$issuedn}, $type . "=" . $i->{'value'}->{ $key[0] };
  12         40  
571             }
572             }
573 3         19 return $issuedn;
574             }
575              
576             sub _issuer_part {
577 6     6   39 my $self = shift;
578 6         11 my $oid = shift;
579 6         14 my $issuerrdn = $self->{'tbsCertificate'}->{'issuer'}->{'rdnSequence'};
580 6         8 foreach my $issue ( @{$issuerrdn} ) {
  6         14  
581 15         17 foreach my $i ( @{$issue} ) {
  15         27  
582 15 100       35 if ( $i->{'type'} eq $oid ) {
583 3         5 my @key = keys( %{ $i->{'value'} } );
  3         9  
584 3         19 return $i->{'value'}->{ $key[0] };
585             }
586             }
587             }
588 3         12 return undef;
589             }
590              
591             =head2 issuer_cn
592              
593             Returns the string value for issuer's common name (= the value with the
594             OID 2.5.4.3 or in DN Syntax everything after C).
595             Only the first entry is returned. C if issuer contains no common name attribute.
596              
597             =cut back
598              
599             sub issuer_cn {
600 1     1 1 3 my $self = shift;
601 1         4 return _issuer_part( $self, '2.5.4.3' );
602             }
603              
604             =head2 issuer_country
605              
606             Returns the string value for issuer's country (= the value with the
607             OID 2.5.4.6 or in DN Syntax everything after C).
608             Only the first entry is returned. C if issuer contains no country attribute.
609              
610             =cut back
611              
612             sub issuer_country {
613 1     1 1 3 my $self = shift;
614 1         4 return _issuer_part( $self, '2.5.4.6' );
615             }
616              
617             =head2 issuer_state
618              
619             Returns the string value for issuer's state or province (= the value with the
620             OID 2.5.4.8 or in DN Syntax everything after C).
621             Only the first entry is returned. C if issuer contains no state attribute.
622              
623             =cut back
624              
625             sub issuer_state {
626 1     1 1 3 my $self = shift;
627 1         3 return _issuer_part( $self, '2.5.4.8' );
628             }
629              
630             =head2 issuer_locality
631              
632             Returns the string value for issuer's locality (= the value with the
633             OID 2.5.4.7 or in DN Syntax everything after C).
634             Only the first entry is returned. C if issuer contains no locality attribute.
635              
636             =cut back
637              
638             sub issuer_locality {
639 1     1 1 2 my $self = shift;
640 1         5 return _issuer_part( $self, '2.5.4.7' );
641             }
642              
643             =head2 issuer_org
644              
645             Returns the string value for issuer's organization (= the value with the
646             OID 2.5.4.10 or in DN Syntax everything after C).
647             Only the first entry is returned. C if issuer contains no organization attribute.
648              
649             =cut back
650              
651             sub issuer_org {
652 1     1 1 3 my $self = shift;
653 1         4 return _issuer_part( $self, '2.5.4.10' );
654             }
655              
656             =head2 issuer_email
657              
658             Returns the string value for issuer's email address (= the value with the
659             OID 1.2.840.113549.1.9.1 or in DN Syntax everything after C).
660             Only the first entry is returned. C if issuer contains no email attribute.
661              
662             =cut back
663              
664             sub issuer_email {
665 1     1 1 3 my $self = shift;
666 1         3 return _issuer_part( $self, '1.2.840.113549.1.9.1' );
667             }
668             #########################################################################
669             # accessors - extensions (automate this)
670             #########################################################################
671              
672             =head2 KeyUsage
673              
674             returns a pointer to an array of strings describing the valid Usages
675             for this certificate. C is returned, when the extension is not set in the
676             certificate.
677              
678             If the extension is marked critical, this is also reported.
679              
680             $decoded= Crypt::X509->new(cert => $cert);
681             print "Allowed usages for this Certificate are:\n".join("\n",@{$decoded->KeyUsage})."\n";
682              
683             Example Output:
684             Allowed usages for this Certificate are:
685             critical
686             digitalSignature
687             keyEncipherment
688             dataEncipherment
689              
690             =cut back
691             sub KeyUsage {
692 3     3 1 5 my $self = shift;
693 3         6 my $ext;
694 3         7 my $exts = $self->{'tbsCertificate'}->{'extensions'};
695 3 50       9 if ( !defined $exts ) { return undef; }
  0         0  
696             ; # no extensions in certificate
697 3         4 foreach $ext ( @{$exts} ) {
  3         8  
698 5 100       13 if ( $ext->{'extnID'} eq '2.5.29.15' ) { #OID for keyusage
699 3         7 my $parsKeyU = _init('KeyUsage'); # get a parser for this
700 3         10 my $keyusage = $parsKeyU->decode( $ext->{'extnValue'} ); # decode the value
701 3 50       230 if ( $parsKeyU->error ) {
702 0         0 $self->{"_error"} = $parsKeyU->error;
703 0         0 return undef;
704             }
705 3         16 my $keyu = unpack( "n", ${$keyusage}[0] . ${$keyusage}[1] ) & 0xff80;
  3         16  
  3         14  
706 3         8 $ext->{'usage'} = [];
707 3 50       8 if ( $ext->{'critical'} ) { push @{ $ext->{'usage'} }, "critical"; } # mark as critical, if appropriate
  3         5  
  3         18  
708 3 50       8 if ( $keyu & 0x8000 ) { push @{ $ext->{'usage'} }, "digitalSignature"; }
  3         5  
  3         6  
709 3 50       7 if ( $keyu & 0x4000 ) { push @{ $ext->{'usage'} }, "nonRepudiation"; }
  0         0  
  0         0  
710 3 100       6 if ( $keyu & 0x2000 ) { push @{ $ext->{'usage'} }, "keyEncipherment"; }
  2         3  
  2         5  
711 3 100       6 if ( $keyu & 0x1000 ) { push @{ $ext->{'usage'} }, "dataEncipherment"; }
  2         5  
  2         3  
712 3 100       8 if ( $keyu & 0x0800 ) { push @{ $ext->{'usage'} }, "keyAgreement"; }
  1         2  
  1         2  
713 3 50       7 if ( $keyu & 0x0400 ) { push @{ $ext->{'usage'} }, "keyCertSign"; }
  0         0  
  0         0  
714 3 50       6 if ( $keyu & 0x0200 ) { push @{ $ext->{'usage'} }, "cRLSign"; }
  0         0  
  0         0  
715 3 50       8 if ( $keyu & 0x0100 ) { push @{ $ext->{'usage'} }, "encipherOnly"; }
  0         0  
  0         0  
716 3 50       6 if ( $keyu & 0x0080 ) { push @{ $ext->{'usage'} }, "decipherOnly"; }
  0         0  
  0         0  
717 3         30 return $ext->{'usage'};
718             }
719             }
720 0         0 return undef; # keyusage extension not found
721             }
722              
723             =head2 ExtKeyUsage
724              
725             returns a pointer to an array of ExtKeyUsage strings (or OIDs for unknown OIDs) or
726             C if the extension is not filled. OIDs of the following ExtKeyUsages are known:
727             serverAuth, clientAuth, codeSigning, emailProtection, timeStamping, OCSPSigning
728              
729             If the extension is marked critical, this is also reported.
730              
731             $decoded= Crypt::X509->new($cert);
732             print "ExtKeyUsage extension of this Certificates is: ", join(", ", @{$decoded->ExtKeyUsage}), "\n";
733              
734             Example Output: ExtKeyUsage extension of this Certificates is: critical, serverAuth
735              
736             =cut back
737             our %oid2extkeyusage = (
738             '1.3.6.1.5.5.7.3.1' => 'serverAuth',
739             '1.3.6.1.5.5.7.3.2' => 'clientAuth',
740             '1.3.6.1.5.5.7.3.3' => 'codeSigning',
741             '1.3.6.1.5.5.7.3.4' => 'emailProtection',
742             '1.3.6.1.5.5.7.3.8' => 'timeStamping',
743             '1.3.6.1.5.5.7.3.9' => 'OCSPSigning',
744             );
745              
746             sub ExtKeyUsage {
747 2     2 1 5 my $self = shift;
748 2         3 my $ext;
749 2         4 my $exts = $self->{'tbsCertificate'}->{'extensions'};
750 2 50       7 if ( !defined $exts ) { return undef; }
  0         0  
751             ; # no extensions in certificate
752 2         4 foreach $ext ( @{$exts} ) {
  2         5  
753 14 100       27 if ( $ext->{'extnID'} eq '2.5.29.37' ) { #OID for ExtKeyUsage
754 2 100       11 return $ext->{'oids'} if defined $ext->{'oids'};
755 1         4 my $parsExtKeyUsage = _init('ExtKeyUsageSyntax'); # get a parser for this
756 1         4 my $oids = $parsExtKeyUsage->decode( $ext->{'extnValue'} ); # decode the value
757 1 50       165 if ( $parsExtKeyUsage->error ) {
758 0         0 $self->{"_error"} = $parsExtKeyUsage->error;
759 0         0 return undef;
760             }
761 1 50       7 $ext->{'oids'} = [ map { $oid2extkeyusage{$_} || $_ } @$oids ];
  2         12  
762 1 50       7 if ( $ext->{'critical'} ) { unshift @{ $ext->{'oids'} }, "critical"; } # mark as critical, if appropriate
  0         0  
  0         0  
763 1         9 return $ext->{'oids'};
764             }
765             }
766 0         0 return undef;
767             }
768              
769             =head2 SubjectAltName
770              
771             returns a pointer to an array of strings containing alternative Subjectnames or
772             C if the extension is not filled. Usually this Extension holds the e-Mail
773             address for person-certificates or DNS-Names for server certificates.
774              
775             It also pre-pends the field type (ie rfc822Name) to the returned value.
776              
777             $decoded= Crypt::X509->new($cert);
778             print "E-Mail or Hostnames in this Certificates is/are:", join(", ", @{$decoded->SubjectAltName}), "\n";
779              
780             Example Output: E-Mail or Hostnames in this Certificates is/are: rfc822Name=user@server.com
781              
782             =cut back
783              
784             sub SubjectAltName {
785 1     1 1 3 my $self = shift;
786 1         2 my $ext;
787 1         3 my $exts = $self->{'tbsCertificate'}->{'extensions'};
788 1 50       6 if ( !defined $exts ) { return undef; }
  0         0  
789             ; # no extensions in certificate
790 1         2 foreach $ext ( @{$exts} ) {
  1         3  
791 5 100       13 if ( $ext->{'extnID'} eq '2.5.29.17' ) { #OID for SubjectAltName
792 1         3 my $parsSubjAlt = _init('SubjectAltName'); # get a parser for this
793 1         4 my $altnames = $parsSubjAlt->decode( $ext->{'extnValue'} ); # decode the value
794 1 50       143 if ( $parsSubjAlt->error ) {
795 0         0 $self->{"_error"} = $parsSubjAlt->error;
796 0         0 return undef;
797             }
798 1         8 $ext->{'names'} = [];
799 1         2 foreach my $name ( @{$altnames} ) {
  1         3  
800 1         2 foreach my $value ( keys %{$name} ) {
  1         4  
801 1         2 push @{ $ext->{'names'} }, "$value=" . $name->{$value};
  1         5  
802             }
803             }
804 1         9 return $ext->{'names'};
805             }
806             }
807 0         0 return undef;
808             }
809              
810             =head2 DecodedSubjectAltNames
811              
812             Returns a pointer to an array of strings containing all the alternative subject name
813             extensions.
814              
815             Each such extension is represented as a decoded ASN.1 value, i.e. a pointer to a list
816             of pointers to objects, each object having a single key with the type of the alternative
817             name and a value specific to that type.
818              
819             Example return value:
820              
821             [
822             [
823             {
824             'directoryName' => {
825             'rdnSequence' => [
826             [
827             {
828             'value' => { 'utf8String' => 'example' },
829             'type' => '2.5.4.3'
830             }
831             ]
832             ]
833             }
834             },
835             {
836             'dNSName' => 'example.com'
837             }
838             ]
839             ]
840              
841             =cut back
842              
843             sub DecodedSubjectAltNames {
844 2     2 1 6 my $self = shift;
845 2         5 my @sans = ();
846 2         6 my $exts = $self->{'tbsCertificate'}->{'extensions'};
847 2         4 foreach my $ext ( @{$exts} ) {
  2         5  
848 9 100       23 if ( $ext->{'extnID'} eq '2.5.29.17' ) { #OID for subjectAltName
849 2         7 my $parsSubjAlt = _init('SubjectAltName');
850 2         9 my $altnames = $parsSubjAlt->decode( $ext->{'extnValue'} );
851 2 50       584 if ( $parsSubjAlt->error ) {
852 0         0 $self->{'_error'} = $parsSubjAlt->error;
853 0         0 return undef;
854             }
855 2         16 push @sans, $altnames;
856             }
857             }
858 2         22 return \@sans;
859             }
860              
861             #########################################################################
862             # accessors - authorityCertIssuer
863             #########################################################################
864             sub _AuthorityKeyIdentifier {
865 7     7   10 my $self = shift;
866 7         10 my $ext;
867 7         14 my $exts = $self->{'tbsCertificate'}->{'extensions'};
868 7 50       18 if ( !defined $exts ) { return undef; }
  0         0  
869             ; # no extensions in certificate
870 7 100       17 if ( defined $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} ) {
871 6         12 return ( $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} );
872             }
873 1         3 foreach $ext ( @{$exts} ) {
  1         3  
874 10 100       19 if ( $ext->{'extnID'} eq '2.5.29.35' ) { #OID for AuthorityKeyIdentifier
875 1         3 my $pars = _init('AuthorityKeyIdentifier'); # get a parser for this
876 1         4 $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} = $pars->decode( $ext->{'extnValue'} ); # decode the value
877 1 50       881 if ( $pars->error ) {
878 0         0 $self->{"_error"} = $pars->error;
879 0         0 return undef;
880             }
881 1         8 return $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'};
882             }
883             }
884 0         0 return undef;
885             }
886              
887             =head2 authorityCertIssuer
888              
889             returns a pointer to an array of strings building the DN of the Authority Cert
890             Issuer. Attributenames for the most common Attributes
891             are translated from the OID-Numbers, unknown numbers are output verbatim.
892             undef if the extension is not set in the certificate.
893              
894             $decoded= Crypt::X509->new($cert);
895             print "Certificate was authorised by:".join(',',@{$decoded->authorityCertIssuer})."\n";
896              
897             =cut back
898              
899             sub authorityCertIssuer {
900 1     1 1 3 my $self = shift;
901 1         2 my ( $i, $type );
902 1         4 my $rdn = _AuthorityKeyIdentifier($self);
903 1 50       5 if ( !defined($rdn) ) {
904 0         0 return (undef); # we do not have that extension
905             } else {
906 1         3 $rdn = $rdn->{'authorityCertIssuer'}[0]->{'directoryName'};
907             }
908 1         3 $rdn->{'dn'} = [];
909 1         3 my $dn = $rdn->{'dn'};
910 1         2 $rdn = $rdn->{'rdnSequence'};
911 1         2 foreach my $r ( @{$rdn} ) {
  1         3  
912 3         4 $i = @{$r}[0];
  3         6  
913 3 50       9 if ( $oid2attr{ $i->{'type'} } ) {
914 3         8 $type = $oid2attr{ $i->{'type'} };
915             } else {
916 0         0 $type = $i->{'type'};
917             }
918 3         4 my @key = keys( %{ $i->{'value'} } );
  3         19  
919 3         5 push @{$dn}, $type . "=" . $i->{'value'}->{ $key[0] };
  3         13  
920             }
921 1         8 return $dn;
922             }
923              
924             sub _authcert_part {
925 6     6   9 my $self = shift;
926 6         10 my $oid = shift;
927 6         12 my $rdn = _AuthorityKeyIdentifier($self);
928 6 50       14 if ( !defined($rdn) ) {
929 0         0 return (undef); # we do not have that extension
930             } else {
931 6         13 $rdn = $rdn->{'authorityCertIssuer'}[0]->{'directoryName'}->{'rdnSequence'};
932             }
933 6         8 foreach my $r ( @{$rdn} ) {
  6         12  
934 15         18 my $i = @{$r}[0];
  15         25  
935 15 100       33 if ( $i->{'type'} eq $oid ) {
936 3         6 my @key = keys( %{ $i->{'value'} } );
  3         7  
937 3         17 return $i->{'value'}->{ $key[0] };
938             }
939             }
940 3         12 return undef;
941             }
942              
943             =head2 authority_serial
944              
945             Returns the authority's certificate serial number.
946              
947             =cut back
948              
949             sub authority_serial {
950 0     0 1 0 my $self = shift;
951 0         0 return ( $self->_AuthorityKeyIdentifier )->{authorityCertSerialNumber};
952             }
953              
954             =head2 key_identifier
955              
956             Returns the authority key identifier or undef if it is a rooted cert
957              
958             =cut back
959              
960             sub key_identifier {
961 0     0 1 0 my $self = shift;
962 0 0       0 if ( defined $self->_AuthorityKeyIdentifier ) { return ( $self->_AuthorityKeyIdentifier )->{keyIdentifier}; }
  0         0  
963 0         0 return undef;
964             }
965              
966             =head2 authority_cn
967              
968             Returns the authority's ca.
969              
970             =cut back
971              
972             sub authority_cn {
973 1     1 1 3 my $self = shift;
974 1         6 return _authcert_part( $self, '2.5.4.3' );
975             }
976              
977             =head2 authority_country
978              
979             Returns the authority's country.
980              
981             =cut back
982              
983             sub authority_country {
984 1     1 1 3 my $self = shift;
985 1         4 return _authcert_part( $self, '2.5.4.6' );
986             }
987              
988             =head2 authority_state
989              
990             Returns the authority's state.
991              
992             =cut back
993              
994             sub authority_state {
995 1     1 1 4 my $self = shift;
996 1         4 return _authcert_part( $self, '2.5.4.8' );
997             }
998              
999             =head2 authority_locality
1000              
1001             Returns the authority's locality.
1002              
1003             =cut back
1004              
1005             sub authority_locality {
1006 1     1 1 4 my $self = shift;
1007 1         4 return _authcert_part( $self, '2.5.4.7' );
1008             }
1009              
1010             =head2 authority_org
1011              
1012             Returns the authority's organization.
1013              
1014             =cut back
1015              
1016             sub authority_org {
1017 1     1 1 3 my $self = shift;
1018 1         4 return _authcert_part( $self, '2.5.4.10' );
1019             }
1020              
1021             =head2 authority_email
1022              
1023             Returns the authority's email.
1024              
1025             =cut back
1026              
1027             sub authority_email {
1028 1     1 1 2 my $self = shift;
1029 1         4 return _authcert_part( $self, '1.2.840.113549.1.9.1' );
1030             }
1031              
1032             =head2 CRLDistributionPoints
1033              
1034             Returns the CRL distribution points as an array of strings (with one value usually)
1035              
1036             =cut back
1037              
1038             sub CRLDistributionPoints {
1039 1     1 1 3 my $self = shift;
1040 1         2 my $ext;
1041 1         3 my $exts = $self->{'tbsCertificate'}->{'extensions'};
1042 1 50       5 if ( !defined $exts ) { return undef; }
  0         0  
1043             ; # no extensions in certificate
1044 1         2 foreach $ext ( @{$exts} ) {
  1         3  
1045 2 100       7 if ( $ext->{'extnID'} eq '2.5.29.31' ) { #OID for cRLDistributionPoints
1046 1         2 my $crlp = _init('cRLDistributionPoints'); # get a parser for this
1047 1         10 my $points = $crlp->decode( $ext->{'extnValue'} ); # decode the value
1048 1         313 $points = $points->[0]->{'distributionPoint'}->{'fullName'};
1049 1 50       6 if ( $crlp->error ) {
1050 0         0 $self->{"_error"} = $crlp->error;
1051 0         0 return undef;
1052             }
1053 1         6 foreach my $name ( @{$points} ) {
  1         2  
1054 1         2 push @{ $ext->{'crlpoints'} }, $name->{'uniformResourceIdentifier'};
  1         5  
1055             }
1056 1         7 return $ext->{'crlpoints'};
1057             }
1058             }
1059 0         0 return undef;
1060             }
1061              
1062             =head2 CRLDistributionPoints2
1063              
1064             Returns the CRL distribution points as an array of hashes (allowing for some variations)
1065              
1066             =cut back
1067              
1068             # newer CRL
1069             sub CRLDistributionPoints2 {
1070 1     1 1 4 my $self = shift;
1071 1         2 my %CDPs;
1072 1         3 my $dp_cnt = 0; # this is a counter used to show which CDP a particular value is listed in
1073 1         49 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1074 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1075             ; # no extensions in certificate
1076 1         3 for my $extension ( @{$extensions} ) {
  1         3  
1077 1 50       5 if ( $extension->{'extnID'} eq '2.5.29.31' ) { # OID for ARRAY of cRLDistributionPoints
1078 1         3 my $parser = _init('cRLDistributionPoints'); # get a parser for CDPs
1079 1         40 my $points = $parser->decode( $extension->{'extnValue'} ); # decode the values (returns an array)
1080 1         1506 for my $each_dp ( @{$points} ) { # this loops through multiple "distributionPoint" values
  1         3  
1081 1         3 $dp_cnt++;
1082 1         2 for my $each_fullName ( @{ $each_dp->{'distributionPoint'}->{'fullName'} } )
  1         4  
1083             { # this loops through multiple "fullName" values
1084 2 100       8 if ( exists $each_fullName->{directoryName} ) {
    50          
1085              
1086             # found a rdnSequence
1087 1         2 my $rdn = join ',', reverse @{ my_CRL_rdn( $each_fullName->{directoryName}->{rdnSequence} ) };
  1         5  
1088 1         3 push @{ $CDPs{$dp_cnt} }, "Directory Address: $rdn";
  1         5  
1089             } elsif ( exists $each_fullName->{uniformResourceIdentifier} ) {
1090              
1091             # found a URI
1092 1         2 push @{ $CDPs{$dp_cnt} }, "URL: " . $each_fullName->{uniformResourceIdentifier};
  1         5  
1093             } else {
1094              
1095             # found some other type of CDP value
1096             # return undef;
1097             }
1098             }
1099             }
1100 1         12 return %CDPs;
1101             }
1102             }
1103 0         0 return undef;
1104             }
1105              
1106             sub my_CRL_rdn {
1107 1     1 0 3 my $crl_rdn = shift; # this should be the passed in 'rdnSequence' array
1108 1         2 my ( $i, $type );
1109 1         2 my $crl_dn = [];
1110 1         3 for my $part ( @{$crl_rdn} ) {
  1         3  
1111 6         9 $i = @{$part}[0];
  6         8  
1112 6 50       17 if ( $oid2attr{ $i->{'type'} } ) {
1113 6         12 $type = $oid2attr{ $i->{'type'} };
1114             } else {
1115 0         0 $type = $i->{'type'};
1116             }
1117 6         8 my @key = keys( %{ $i->{'value'} } );
  6         16  
1118 6         7 push @{$crl_dn}, $type . "=" . $i->{'value'}->{ $key[0] };
  6         20  
1119             }
1120 1         5 return $crl_dn;
1121             }
1122              
1123             =head2 CertificatePolicies
1124              
1125             Returns the CertificatePolicies as an array of strings
1126              
1127             =cut back
1128              
1129             # CertificatePolicies (another extension)
1130             sub CertificatePolicies {
1131 0     0 1 0 my $self = shift;
1132 0         0 my $extension;
1133 0         0 my $CertPolicies = [];
1134 0         0 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1135 0 0       0 if ( !defined $extensions ) { return undef; }
  0         0  
1136             ; # no extensions in certificate
1137 0         0 for $extension ( @{$extensions} ) {
  0         0  
1138 0 0       0 if ( $extension->{'extnID'} eq '2.5.29.32' ) { # OID for CertificatePolicies
1139 0         0 my $parser = _init('CertificatePolicies'); # get a parser for this
1140 0         0 my $policies = $parser->decode( $extension->{'extnValue'} ); # decode the value
1141 0         0 for my $policy ( @{$policies} ) {
  0         0  
1142 0         0 for my $key ( keys %{$policy} ) {
  0         0  
1143 0         0 push @{$CertPolicies}, "$key=" . $policy->{$key};
  0         0  
1144             }
1145             }
1146 0         0 return $CertPolicies;
1147             }
1148             }
1149 0         0 return undef;
1150             }
1151              
1152             =head2 EntrustVersionInfo
1153              
1154             Returns the EntrustVersion as a string
1155              
1156             print "Entrust Version: ", $decoded->EntrustVersion, "\n";
1157              
1158             Example Output: Entrust Version: V7.0
1159              
1160             =cut back
1161              
1162             # EntrustVersion (another extension)
1163             sub EntrustVersion {
1164 1     1 0 4 my $self = shift;
1165 1         3 my $extension;
1166 1         4 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1167 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1168             ; # no extensions in certificate
1169 1         3 for $extension ( @{$extensions} ) {
  1         4  
1170 7 100       15 if ( $extension->{'extnID'} eq '1.2.840.113533.7.65.0' ) { # OID for EntrustVersionInfo
1171 1         5 my $parser = _init('EntrustVersionInfo'); # get a parser for this
1172 1         6 my $entrust = $parser->decode( $extension->{'extnValue'} ); # decode the value
1173 1         165 return $entrust->{'entrustVers'};
1174              
1175             # not doing anything with the EntrustInfoFlags BIT STRING (yet)
1176             # $entrust->{'entrustInfoFlags'}
1177             }
1178             }
1179 0         0 return undef;
1180             }
1181              
1182             =head2 SubjectDirectoryAttributes
1183              
1184             Returns the SubjectDirectoryAttributes as an array of key = value pairs, to include a data type
1185              
1186             print "Subject Directory Attributes: ", join( ', ' , @{ $decoded->SubjectDirectoryAttributes } ), "\n";
1187              
1188             Example Output: Subject Directory Attributes: 1.2.840.113533.7.68.29 = 7 (integer)
1189              
1190             =cut back
1191              
1192             # SubjectDirectoryAttributes (another extension)
1193             sub SubjectDirectoryAttributes {
1194 0     0 1 0 my $self = shift;
1195 0         0 my $extension;
1196 0         0 my $attributes = [];
1197 0         0 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1198 0 0       0 if ( !defined $extensions ) { return undef; }
  0         0  
1199             ; # no extensions in certificate
1200 0         0 for $extension ( @{$extensions} ) {
  0         0  
1201 0 0       0 if ( $extension->{'extnID'} eq '2.5.29.9' ) { # OID for SubjectDirectoryAttributes
1202 0         0 my $parser = _init('SubjectDirectoryAttributes'); # get a parser for this
1203 0         0 my $subject_dir_attrs = $parser->decode( $extension->{'extnValue'} ); # decode the value
1204 0         0 for my $type ( @{$subject_dir_attrs} ) {
  0         0  
1205 0         0 for my $value ( @{ $type->{'values'} } ) {
  0         0  
1206 0         0 for my $key ( keys %{$value} ) {
  0         0  
1207 0         0 push @{$attributes}, $type->{'type'} . " = " . $value->{$key} . " ($key)";
  0         0  
1208             }
1209             }
1210             }
1211 0         0 return $attributes;
1212             }
1213             }
1214 0         0 return undef;
1215             }
1216              
1217             =head2 BasicConstraints
1218              
1219             Returns the BasicConstraints as an array and the criticallity pre-pended.
1220              
1221             =cut back
1222              
1223             # BasicConstraints (another extension)
1224             sub BasicConstraints {
1225 1     1 1 3 my $self = shift;
1226 1         2 my $extension;
1227 1         4 my $constraints = [];
1228 1         4 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1229 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1230             ; # no extensions in certificate
1231 1         3 for $extension ( @{$extensions} ) {
  1         3  
1232 2 100       7 if ( $extension->{'extnID'} eq '2.5.29.19' ) { # OID for BasicConstraints
1233 1 50       6 if ( $extension->{'critical'} ) { push @{$constraints}, "critical"; } # mark this as critical as appropriate
  1         2  
  1         4  
1234 1         5 my $parser = _init('BasicConstraints'); # get a parser for this
1235 1         6 my $basic_constraints = $parser->decode( $extension->{'extnValue'} ); # decode the value
1236 1         136 for my $key ( keys %{$basic_constraints} ) {
  1         6  
1237 1         2 push @{$constraints}, "$key = " . $basic_constraints->{$key};
  1         6  
1238             }
1239 1         10 return $constraints;
1240             }
1241             }
1242 0         0 return undef;
1243             }
1244              
1245             =head2 subject_keyidentifier
1246              
1247             Returns the subject key identifier from the extensions.
1248              
1249             =cut back
1250              
1251             # subject_keyidentifier (another extension)
1252             sub subject_keyidentifier {
1253 1     1 1 570 my $self = shift;
1254 1         5 return $self->_SubjectKeyIdentifier;
1255             }
1256              
1257             # _SubjectKeyIdentifier (another extension)
1258             sub _SubjectKeyIdentifier {
1259 1     1   2 my $self = shift;
1260 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1261 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1262             ; # no extensions in certificate
1263 1 50       4 if ( defined $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} ) {
1264 0         0 return ( $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} );
1265             }
1266 1         2 for my $extension ( @{$extensions} ) {
  1         3  
1267 4 100       10 if ( $extension->{'extnID'} eq '2.5.29.14' ) { # OID for SubjectKeyIdentifier
1268 1         3 my $parser = _init('SubjectKeyIdentifier'); # get a parser for this
1269 1         5 $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} = $parser->decode( $extension->{'extnValue'} ); # decode the value
1270 1 50       80 if ( $parser->error ) {
1271 0         0 $self->{"_error"} = $parser->error;
1272 0         0 return undef;
1273             }
1274 1         11 return $self->{'tbsCertificate'}{'SubjectKeyIdentifier'};
1275             }
1276             }
1277 0         0 return undef;
1278             }
1279              
1280             =head2 SubjectInfoAccess
1281              
1282             Returns the SubjectInfoAccess as an array of hashes with key=value pairs.
1283              
1284             print "Subject Info Access: ";
1285             if ( defined $decoded->SubjectInfoAccess ) {
1286             my %SIA = $decoded->SubjectInfoAccess;
1287             for my $key ( keys %SIA ) {
1288             print "\n\t$key: \n\t";
1289             print join( "\n\t" , @{ $SIA{$key} } ), "\n";
1290             }
1291             } else { print "\n" }
1292              
1293             Example Output:
1294             Subject Info Access:
1295             1.3.6.1.5.5.7.48.5:
1296             uniformResourceIdentifier = http://pki.treas.gov/root_sia.p7c
1297             uniformResourceIdentifier = ldap://ldap.treas.gov/ou=US%20Treasury%20Root%20CA,ou=Certification%20Authorities,ou=Department%20of%20the%20Treasury,o=U.S.%20Government,c=US?cACertificate;binary,crossCertificatePair;binary
1298              
1299             =cut back
1300              
1301             # SubjectInfoAccess (another extension)
1302             sub SubjectInfoAccess {
1303 1     1 1 3 my $self = shift;
1304 1         3 my $extension;
1305             my %SIA;
1306 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1307 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1308             ; # no extensions in certificate
1309 1         3 for $extension ( @{$extensions} ) {
  1         4  
1310 3 100       9 if ( $extension->{'extnID'} eq '1.3.6.1.5.5.7.1.11' ) { # OID for SubjectInfoAccess
1311 1         4 my $parser = _init('SubjectInfoAccessSyntax'); # get a parser for this
1312 1         5 my $subject_info_access = $parser->decode( $extension->{'extnValue'} ); # decode the value
1313 1         422 for my $sia ( @{$subject_info_access} ) {
  1         3  
1314 2         3 for my $key ( keys %{ $sia->{'accessLocation'} } ) {
  2         6  
1315 2         5 push @{ $SIA{ $sia->{'accessMethod'} } }, "$key = " . $sia->{'accessLocation'}{$key};
  2         12  
1316             }
1317             }
1318 1         9 return %SIA;
1319             }
1320             }
1321 0         0 return undef;
1322             }
1323              
1324              
1325             =head2 PGPExtension
1326              
1327             Returns the creation timestamp of the corresponding OpenPGP key.
1328             (see http://www.imc.org/ietf-openpgp/mail-archive/msg05320.html)
1329              
1330             print "PGPExtension: ";
1331             if ( defined $decoded->PGPExtension ) {
1332             my $creationtime = $decoded->PGPExtension;
1333             printf "\n\tcorresponding OpenPGP Creation Time: ", $creationtime, "\n";
1334             }
1335              
1336             Example Output:
1337             PGPExtension:
1338             whatever
1339              
1340             =cut back
1341              
1342             # PGPExtension (another extension)
1343             sub PGPExtension {
1344 1     1 1 4 my $self = shift;
1345 1         2 my $extension;
1346 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1347 1 50       12 if ( !defined $extensions ) { return undef; }
  0         0  
1348             ; # no extensions in certificate
1349 1         2 for $extension ( @{$extensions} ) {
  1         4  
1350 6 100       13 if ( $extension->{'extnID'} eq '1.3.6.1.4.1.3401.8.1.1' ) { # OID for PGPExtension
1351 1         3 my $parser = _init('PGPExtension'); # get a parser for this
1352 1         4 my $pgpextension = $parser->decode( $extension->{'extnValue'} ); # decode the value
1353 1 50       233 if ($pgpextension->{version} != 0) {
1354 0         0 $self->{"_error"} = sprintf("got PGPExtension version %d. We only know how to deal with v1 (0)", $pgpextension->{version});
1355             } else {
1356 1         4 foreach my $timetype ('generalTime', 'utcTime') {
1357             return $pgpextension->{keyCreation}->{$timetype}
1358 1 50       9 if exists $pgpextension->{keyCreation}->{$timetype};
1359             }
1360             }
1361             }
1362             }
1363 0         0 return undef;
1364             }
1365              
1366             #######################################################################
1367             # internal functions
1368             #######################################################################
1369             sub _init {
1370 19     19   35 my $what = shift;
1371 19 100 66     95 if ( ( !defined $what ) || ( '' eq $what ) ) { $what = 'Certificate' }
  2         4  
1372 19 100       43 if ( !defined $asn ) {
1373 1         8 $asn = Convert::ASN1->new;
1374 1         45 $asn->prepare(<
1375             -- ASN.1 from RFC2459 and X.509(2001)
1376             -- Adapted for use with Convert::ASN1
1377             -- Id: x509decode,v 1.1 2002/02/10 16:41:28 gbarr Exp
1378              
1379             -- attribute data types --
1380              
1381             Attribute ::= SEQUENCE {
1382             type AttributeType,
1383             values SET OF AttributeValue
1384             -- at least one value is required --
1385             }
1386              
1387             AttributeType ::= OBJECT IDENTIFIER
1388              
1389             AttributeValue ::= DirectoryString --ANY
1390              
1391             AttributeTypeAndValue ::= SEQUENCE {
1392             type AttributeType,
1393             value AttributeValue
1394             }
1395              
1396              
1397             -- naming data types --
1398              
1399             Name ::= CHOICE { -- only one possibility for now
1400             rdnSequence RDNSequence
1401             }
1402              
1403             RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
1404              
1405             DistinguishedName ::= RDNSequence
1406              
1407             RelativeDistinguishedName ::=
1408             SET OF AttributeTypeAndValue --SET SIZE (1 .. MAX) OF
1409              
1410              
1411             -- Directory string type --
1412              
1413             DirectoryString ::= CHOICE {
1414             teletexString TeletexString, --(SIZE (1..MAX)),
1415             printableString PrintableString, --(SIZE (1..MAX)),
1416             bmpString BMPString, --(SIZE (1..MAX)),
1417             universalString UniversalString, --(SIZE (1..MAX)),
1418             utf8String UTF8String, --(SIZE (1..MAX)),
1419             ia5String IA5String, --added for EmailAddress,
1420             integer INTEGER
1421             }
1422              
1423              
1424             -- certificate and CRL specific structures begin here
1425              
1426             Certificate ::= SEQUENCE {
1427             tbsCertificate TBSCertificate,
1428             signatureAlgorithm AlgorithmIdentifier,
1429             signature BIT STRING
1430             }
1431              
1432             TBSCertificate ::= SEQUENCE {
1433             version [0] EXPLICIT Version OPTIONAL, --DEFAULT v1
1434             serialNumber CertificateSerialNumber,
1435             signature AlgorithmIdentifier,
1436             issuer Name,
1437             validity Validity,
1438             subject Name,
1439             subjectPublicKeyInfo SubjectPublicKeyInfo,
1440             issuerUniqueID [1] IMPLICIT UniqueIdentifier OPTIONAL,
1441             -- If present, version shall be v2 or v3
1442             subjectUniqueID [2] IMPLICIT UniqueIdentifier OPTIONAL,
1443             -- If present, version shall be v2 or v3
1444             extensions [3] EXPLICIT Extensions OPTIONAL
1445             -- If present, version shall be v3
1446             }
1447              
1448             Version ::= INTEGER --{ v1(0), v2(1), v3(2) }
1449              
1450             CertificateSerialNumber ::= INTEGER
1451              
1452             Validity ::= SEQUENCE {
1453             notBefore Time,
1454             notAfter Time
1455             }
1456              
1457             Time ::= CHOICE {
1458             utcTime UTCTime,
1459             generalTime GeneralizedTime
1460             }
1461              
1462             UniqueIdentifier ::= BIT STRING
1463              
1464             SubjectPublicKeyInfo ::= SEQUENCE {
1465             algorithm AlgorithmIdentifier,
1466             subjectPublicKey BIT STRING
1467             }
1468              
1469              
1470             RSAPubKeyInfo ::= SEQUENCE {
1471             modulus INTEGER,
1472             exponent INTEGER
1473             }
1474              
1475             Extensions ::= SEQUENCE OF Extension --SIZE (1..MAX) OF Extension
1476              
1477             Extension ::= SEQUENCE {
1478             extnID OBJECT IDENTIFIER,
1479             critical BOOLEAN OPTIONAL, --DEFAULT FALSE,
1480             extnValue OCTET STRING
1481             }
1482              
1483             AlgorithmIdentifier ::= SEQUENCE {
1484             algorithm OBJECT IDENTIFIER,
1485             parameters ANY OPTIONAL
1486             }
1487              
1488              
1489             --extensions
1490              
1491             AuthorityKeyIdentifier ::= SEQUENCE {
1492             keyIdentifier [0] KeyIdentifier OPTIONAL,
1493             authorityCertIssuer [1] GeneralNames OPTIONAL,
1494             authorityCertSerialNumber [2] CertificateSerialNumber OPTIONAL }
1495             -- authorityCertIssuer and authorityCertSerialNumber shall both
1496             -- be present or both be absent
1497              
1498             KeyIdentifier ::= OCTET STRING
1499              
1500             SubjectKeyIdentifier ::= KeyIdentifier
1501              
1502             -- key usage extension OID and syntax
1503              
1504             -- id-ce-keyUsage OBJECT IDENTIFIER ::= { id-ce 15 }
1505              
1506             KeyUsage ::= BIT STRING --{
1507             -- digitalSignature (0),
1508             -- nonRepudiation (1),
1509             -- keyEncipherment (2),
1510             -- dataEncipherment (3),
1511             -- keyAgreement (4),
1512             -- keyCertSign (5),
1513             -- cRLSign (6),
1514             -- encipherOnly (7),
1515             -- decipherOnly (8) }
1516              
1517              
1518             -- private key usage period extension OID and syntax
1519              
1520             -- id-ce-privateKeyUsagePeriod OBJECT IDENTIFIER ::= { id-ce 16 }
1521              
1522             PrivateKeyUsagePeriod ::= SEQUENCE {
1523             notBefore [0] GeneralizedTime OPTIONAL,
1524             notAfter [1] GeneralizedTime OPTIONAL }
1525             -- either notBefore or notAfter shall be present
1526              
1527             -- certificate policies extension OID and syntax
1528             -- id-ce-certificatePolicies OBJECT IDENTIFIER ::= { id-ce 32 }
1529              
1530             CertificatePolicies ::= SEQUENCE OF PolicyInformation
1531              
1532             PolicyInformation ::= SEQUENCE {
1533             policyIdentifier CertPolicyId,
1534             policyQualifiers SEQUENCE OF
1535             PolicyQualifierInfo OPTIONAL }
1536              
1537             CertPolicyId ::= OBJECT IDENTIFIER
1538              
1539             PolicyQualifierInfo ::= SEQUENCE {
1540             policyQualifierId PolicyQualifierId,
1541             qualifier ANY } --DEFINED BY policyQualifierId }
1542              
1543             -- Implementations that recognize additional policy qualifiers shall
1544             -- augment the following definition for PolicyQualifierId
1545              
1546             PolicyQualifierId ::=
1547             OBJECT IDENTIFIER --( id-qt-cps | id-qt-unotice )
1548              
1549             -- CPS pointer qualifier
1550              
1551             CPSuri ::= IA5String
1552              
1553             -- user notice qualifier
1554              
1555             UserNotice ::= SEQUENCE {
1556             noticeRef NoticeReference OPTIONAL,
1557             explicitText DisplayText OPTIONAL}
1558              
1559             NoticeReference ::= SEQUENCE {
1560             organization DisplayText,
1561             noticeNumbers SEQUENCE OF INTEGER }
1562              
1563             DisplayText ::= CHOICE {
1564             visibleString VisibleString ,
1565             bmpString BMPString ,
1566             utf8String UTF8String }
1567              
1568              
1569             -- policy mapping extension OID and syntax
1570             -- id-ce-policyMappings OBJECT IDENTIFIER ::= { id-ce 33 }
1571              
1572             PolicyMappings ::= SEQUENCE OF SEQUENCE {
1573             issuerDomainPolicy CertPolicyId,
1574             subjectDomainPolicy CertPolicyId }
1575              
1576              
1577             -- subject alternative name extension OID and syntax
1578             -- id-ce-subjectAltName OBJECT IDENTIFIER ::= { id-ce 17 }
1579              
1580             SubjectAltName ::= GeneralNames
1581              
1582             GeneralNames ::= SEQUENCE OF GeneralName
1583              
1584             GeneralName ::= CHOICE {
1585             otherName [0] AnotherName,
1586             rfc822Name [1] IA5String,
1587             dNSName [2] IA5String,
1588             x400Address [3] ANY, --ORAddress,
1589             directoryName [4] Name,
1590             ediPartyName [5] EDIPartyName,
1591             uniformResourceIdentifier [6] IA5String,
1592             iPAddress [7] OCTET STRING,
1593             registeredID [8] OBJECT IDENTIFIER }
1594              
1595             EntrustVersionInfo ::= SEQUENCE {
1596             entrustVers GeneralString,
1597             entrustInfoFlags EntrustInfoFlags }
1598              
1599             EntrustInfoFlags::= BIT STRING --{
1600             -- keyUpdateAllowed
1601             -- newExtensions (1), -- not used
1602             -- pKIXCertificate (2) } -- certificate created by pkix
1603              
1604             -- AnotherName replaces OTHER-NAME ::= TYPE-IDENTIFIER, as
1605             -- TYPE-IDENTIFIER is not supported in the 88 ASN.1 syntax
1606              
1607             AnotherName ::= SEQUENCE {
1608             type OBJECT IDENTIFIER,
1609             value [0] EXPLICIT ANY } --DEFINED BY type-id }
1610              
1611             EDIPartyName ::= SEQUENCE {
1612             nameAssigner [0] DirectoryString OPTIONAL,
1613             partyName [1] DirectoryString }
1614              
1615              
1616             -- issuer alternative name extension OID and syntax
1617             -- id-ce-issuerAltName OBJECT IDENTIFIER ::= { id-ce 18 }
1618              
1619             IssuerAltName ::= GeneralNames
1620              
1621              
1622             -- id-ce-subjectDirectoryAttributes OBJECT IDENTIFIER ::= { id-ce 9 }
1623              
1624             SubjectDirectoryAttributes ::= SEQUENCE OF Attribute
1625              
1626              
1627             -- basic constraints extension OID and syntax
1628             -- id-ce-basicConstraints OBJECT IDENTIFIER ::= { id-ce 19 }
1629              
1630             BasicConstraints ::= SEQUENCE {
1631             cA BOOLEAN OPTIONAL, --DEFAULT FALSE,
1632             pathLenConstraint INTEGER OPTIONAL }
1633              
1634              
1635             -- name constraints extension OID and syntax
1636             -- id-ce-nameConstraints OBJECT IDENTIFIER ::= { id-ce 30 }
1637              
1638             NameConstraints ::= SEQUENCE {
1639             permittedSubtrees [0] GeneralSubtrees OPTIONAL,
1640             excludedSubtrees [1] GeneralSubtrees OPTIONAL }
1641              
1642             GeneralSubtrees ::= SEQUENCE OF GeneralSubtree
1643              
1644             GeneralSubtree ::= SEQUENCE {
1645             base GeneralName,
1646             minimum [0] BaseDistance OPTIONAL, --DEFAULT 0,
1647             maximum [1] BaseDistance OPTIONAL }
1648              
1649             BaseDistance ::= INTEGER
1650              
1651              
1652             -- policy constraints extension OID and syntax
1653             -- id-ce-policyConstraints OBJECT IDENTIFIER ::= { id-ce 36 }
1654              
1655             PolicyConstraints ::= SEQUENCE {
1656             requireExplicitPolicy [0] SkipCerts OPTIONAL,
1657             inhibitPolicyMapping [1] SkipCerts OPTIONAL }
1658              
1659             SkipCerts ::= INTEGER
1660              
1661              
1662             -- CRL distribution points extension OID and syntax
1663             -- id-ce-cRLDistributionPoints OBJECT IDENTIFIER ::= {id-ce 31}
1664              
1665             cRLDistributionPoints ::= SEQUENCE OF DistributionPoint
1666              
1667             DistributionPoint ::= SEQUENCE {
1668             distributionPoint [0] DistributionPointName OPTIONAL,
1669             reasons [1] ReasonFlags OPTIONAL,
1670             cRLIssuer [2] GeneralNames OPTIONAL }
1671              
1672             DistributionPointName ::= CHOICE {
1673             fullName [0] GeneralNames,
1674             nameRelativeToCRLIssuer [1] RelativeDistinguishedName }
1675              
1676             ReasonFlags ::= BIT STRING --{
1677             -- unused (0),
1678             -- keyCompromise (1),
1679             -- cACompromise (2),
1680             -- affiliationChanged (3),
1681             -- superseded (4),
1682             -- cessationOfOperation (5),
1683             -- certificateHold (6),
1684             -- privilegeWithdrawn (7),
1685             -- aACompromise (8) }
1686              
1687              
1688             -- extended key usage extension OID and syntax
1689             -- id-ce-extKeyUsage OBJECT IDENTIFIER ::= {id-ce 37}
1690              
1691             ExtKeyUsageSyntax ::= SEQUENCE OF KeyPurposeId
1692              
1693             KeyPurposeId ::= OBJECT IDENTIFIER
1694              
1695             -- extended key purpose OIDs
1696             -- id-kp-serverAuth OBJECT IDENTIFIER ::= { id-kp 1 }
1697             -- id-kp-clientAuth OBJECT IDENTIFIER ::= { id-kp 2 }
1698             -- id-kp-codeSigning OBJECT IDENTIFIER ::= { id-kp 3 }
1699             -- id-kp-emailProtection OBJECT IDENTIFIER ::= { id-kp 4 }
1700             -- id-kp-ipsecEndSystem OBJECT IDENTIFIER ::= { id-kp 5 }
1701             -- id-kp-ipsecTunnel OBJECT IDENTIFIER ::= { id-kp 6 }
1702             -- id-kp-ipsecUser OBJECT IDENTIFIER ::= { id-kp 7 }
1703             -- id-kp-timeStamping OBJECT IDENTIFIER ::= { id-kp 8 }
1704              
1705             -- authority info access
1706              
1707             -- id-pe-authorityInfoAccess OBJECT IDENTIFIER ::= { id-pe 1 }
1708              
1709             AuthorityInfoAccessSyntax ::=
1710             SEQUENCE OF AccessDescription --SIZE (1..MAX) OF AccessDescription
1711              
1712             AccessDescription ::= SEQUENCE {
1713             accessMethod OBJECT IDENTIFIER,
1714             accessLocation GeneralName }
1715              
1716             -- subject info access
1717              
1718             -- id-pe-subjectInfoAccess OBJECT IDENTIFIER ::= { id-pe 11 }
1719              
1720             SubjectInfoAccessSyntax ::=
1721             SEQUENCE OF AccessDescription --SIZE (1..MAX) OF AccessDescription
1722              
1723             -- pgp creation time
1724              
1725             PGPExtension ::= SEQUENCE {
1726             version Version, -- DEFAULT v1(0)
1727             keyCreation Time
1728             }
1729             ASN1
1730             }
1731 19         62435 my $self = $asn->find($what);
1732 19         314 return $self;
1733             }
1734              
1735             =head1 SEE ALSO
1736              
1737             See the examples of C and the Mailing List.
1738             An example on how to load certificates can be found in F.
1739              
1740             =head1 ACKNOWLEDGEMENTS
1741              
1742             This module is based on the x509decode script, which was contributed to
1743             Convert::ASN1 in 2002 by Norbert Klasen.
1744              
1745             =head1 AUTHORS
1746              
1747             Mike Jackson ,
1748             Alexander Jung ,
1749             Duncan Segrest
1750             Oliver Welter
1751              
1752             =head1 COPYRIGHT
1753              
1754             Copyright (c) 2005 Mike Jackson .
1755             Copyright (c) 2001-2002 Norbert Klasen, DAASI International GmbH.
1756              
1757             All rights reserved. This program is free software; you can redistribute
1758             it and/or modify it under the same terms as Perl itself.
1759              
1760             =cut
1761             1;
1762             __END__