File Coverage

blib/lib/Crypt/X509.pm
Criterion Covered Total %
statement 392 513 76.4
branch 92 150 61.3
condition 5 6 83.3
subroutine 53 64 82.8
pod 52 54 96.3
total 594 787 75.4


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