File Coverage

blib/lib/Crypt/X509.pm
Criterion Covered Total %
statement 381 500 76.2
branch 89 146 60.9
condition 5 6 83.3
subroutine 52 63 82.5
pod 51 53 96.2
total 578 768 75.2


line stmt bran cond sub pod time code
1             package Crypt::X509;
2 1     1   98274 use Carp;
  1         2  
  1         58  
3 1     1   4 use strict;
  1         2  
  1         17  
4 1     1   3 use warnings;
  1         2  
  1         36  
5 1     1   435 use Convert::ASN1 qw(:io :debug);
  1         29723  
  1         4417  
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.52';
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 2276 my ( $class, %args ) = @_;
100 11 100 100     56 if ( !defined($parser) || $parser->error ) {
101 2         11 $parser = _init();
102             }
103 11         71 my $self = $parser->decode( $args{'cert'} );
104 11         38417 $self->{"_error"} = $parser->error;
105 11         52 bless( $self, $class );
106 11         110 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 985 my $self = shift;
126 10         47 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 3 my $self = shift;
155 1         3 my $v = $self->{tbsCertificate}{version};
156 1 50       4 return "v1" if $v == 0;
157 1 50       4 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 26 my $self = shift;
226 4 100       15 if ( $self->{tbsCertificate}{validity}{notAfter}{utcTime} ) {
    50          
227 2         10 return $self->{tbsCertificate}{validity}{notAfter}{utcTime};
228             } elsif ( $self->{tbsCertificate}{validity}{notAfter}{generalTime} ) {
229 2         13 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 4 my $self = shift;
243 1         4 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 2 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 2 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 5 my $self = shift;
292 2         15 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 19554 my $self = shift;
307 2 50       9 if ($self->PubKeyAlg() eq 'RSA') {
308 2         7 my $parser = _init('RSAPubKeyInfo');
309 2         10 my $values = $parser->decode($self->{tbsCertificate}{subjectPublicKeyInfo}{subjectPublicKey}[0]);
310 2         121457 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 2 my $self = shift;
329 1         6 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 2 my $self = shift;
361 1         7 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 6 my $self = shift;
379 3         6 my ( $i, $type );
380 3         5 my $subjrdn = $self->{'tbsCertificate'}->{'subject'}->{'rdnSequence'};
381 3         8 $self->{'tbsCertificate'}->{'subject'}->{'dn'} = [];
382 3         5 my $subjdn = $self->{'tbsCertificate'}->{'subject'}->{'dn'};
383 3         5 foreach my $subj ( @{$subjrdn} ) {
  3         5  
384 11         14 foreach my $i ( @{$subj} ) {
  11         15  
385 12 50       19 if ( $oid2attr{ $i->{'type'} } ) {
386 12         19 $type = $oid2attr{ $i->{'type'} };
387             } else {
388 0         0 $type = $i->{'type'};
389             }
390 12         12 my @key = keys( %{ $i->{'value'} } );
  12         26  
391 12         13 push @{$subjdn}, $type . "=" . $i->{'value'}->{ $key[0] };
  12         29  
392             }
393             }
394 3         16 return $subjdn;
395             }
396              
397             sub _subject_part {
398 5     5   6 my $self = shift;
399 5         7 my $oid = shift;
400 5         8 my $subjrdn = $self->{'tbsCertificate'}->{'subject'}->{'rdnSequence'};
401 5         5 foreach my $subj ( @{$subjrdn} ) {
  5         9  
402 14         14 foreach my $i ( @{$subj} ) {
  14         19  
403 14 100       26 if ( $i->{'type'} eq $oid ) {
404 3         3 my @key = keys( %{ $i->{'value'} } );
  3         8  
405 3         14 return $i->{'value'}->{ $key[0] };
406             }
407             }
408             }
409 2         8 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         5 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         3 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 12 my $self = shift;
461 1         5 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 2 my $self = shift;
474 1         2 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 10 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 6 my $self = shift;
518 3         5 my ( $i, $type );
519 3         9 my $issuerdn = $self->{'tbsCertificate'}->{'issuer'}->{'rdnSequence'};
520 3         8 $self->{'tbsCertificate'}->{'issuer'}->{'dn'} = [];
521 3         6 my $issuedn = $self->{'tbsCertificate'}->{'issuer'}->{'dn'};
522 3         4 foreach my $issue ( @{$issuerdn} ) {
  3         6  
523 11         14 foreach my $i ( @{$issue} ) {
  11         14  
524 12 50       24 if ( $oid2attr{ $i->{'type'} } ) {
525 12         17 $type = $oid2attr{ $i->{'type'} };
526             } else {
527 0         0 $type = $i->{'type'};
528             }
529 12         12 my @key = keys( %{ $i->{'value'} } );
  12         23  
530 12         14 push @{$issuedn}, $type . "=" . $i->{'value'}->{ $key[0] };
  12         34  
531             }
532             }
533 3         16 return $issuedn;
534             }
535              
536             sub _issuer_part {
537 6     6   8 my $self = shift;
538 6         8 my $oid = shift;
539 6         10 my $issuerrdn = $self->{'tbsCertificate'}->{'issuer'}->{'rdnSequence'};
540 6         6 foreach my $issue ( @{$issuerrdn} ) {
  6         11  
541 15         16 foreach my $i ( @{$issue} ) {
  15         20  
542 15 100       26 if ( $i->{'type'} eq $oid ) {
543 3         4 my @key = keys( %{ $i->{'value'} } );
  3         7  
544 3         14 return $i->{'value'}->{ $key[0] };
545             }
546             }
547             }
548 3         10 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 2 my $self = shift;
561 1         5 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         4 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 2 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 2 my $self = shift;
600 1         3 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 2 my $self = shift;
613 1         4 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 2 my $self = shift;
626 1         3 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 6 my $self = shift;
653 3         5 my $ext;
654 3         4 my $exts = $self->{'tbsCertificate'}->{'extensions'};
655 3 50       8 if ( !defined $exts ) { return undef; }
  0         0  
656             ; # no extensions in certificate
657 3         4 foreach $ext ( @{$exts} ) {
  3         7  
658 5 100       25 if ( $ext->{'extnID'} eq '2.5.29.15' ) { #OID for keyusage
659 3         8 my $parsKeyU = _init('KeyUsage'); # get a parser for this
660 3         8 my $keyusage = $parsKeyU->decode( $ext->{'extnValue'} ); # decode the value
661 3 50       187 if ( $parsKeyU->error ) {
662 0         0 $self->{"_error"} = $parsKeyU->error;
663 0         0 return undef;
664             }
665 3         13 my $keyu = unpack( "n", ${$keyusage}[0] . ${$keyusage}[1] ) & 0xff80;
  3         7  
  3         8  
666 3         6 $ext->{'usage'} = [];
667 3 50       7 if ( $ext->{'critical'} ) { push @{ $ext->{'usage'} }, "critical"; } # mark as critical, if appropriate
  3         4  
  3         7  
668 3 50       5 if ( $keyu & 0x8000 ) { push @{ $ext->{'usage'} }, "digitalSignature"; }
  3         4  
  3         5  
669 3 50       6 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         4  
671 3 100       13 if ( $keyu & 0x1000 ) { push @{ $ext->{'usage'} }, "dataEncipherment"; }
  2         3  
  2         4  
672 3 100       7 if ( $keyu & 0x0800 ) { push @{ $ext->{'usage'} }, "keyAgreement"; }
  1         1  
  1         3  
673 3 50       7 if ( $keyu & 0x0400 ) { push @{ $ext->{'usage'} }, "keyCertSign"; }
  0         0  
  0         0  
674 3 50       6 if ( $keyu & 0x0200 ) { push @{ $ext->{'usage'} }, "cRLSign"; }
  0         0  
  0         0  
675 3 50       6 if ( $keyu & 0x0100 ) { push @{ $ext->{'usage'} }, "encipherOnly"; }
  0         0  
  0         0  
676 3 50       6 if ( $keyu & 0x0080 ) { push @{ $ext->{'usage'} }, "decipherOnly"; }
  0         0  
  0         0  
677 3         22 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 3 my $self = shift;
708 2         3 my $ext;
709 2         17 my $exts = $self->{'tbsCertificate'}->{'extensions'};
710 2 50       6 if ( !defined $exts ) { return undef; }
  0         0  
711             ; # no extensions in certificate
712 2         3 foreach $ext ( @{$exts} ) {
  2         3  
713 14 100       22 if ( $ext->{'extnID'} eq '2.5.29.37' ) { #OID for ExtKeyUsage
714 2 100       10 return $ext->{'oids'} if defined $ext->{'oids'};
715 1         3 my $parsExtKeyUsage = _init('ExtKeyUsageSyntax'); # get a parser for this
716 1         3 my $oids = $parsExtKeyUsage->decode( $ext->{'extnValue'} ); # decode the value
717 1 50       128 if ( $parsExtKeyUsage->error ) {
718 0         0 $self->{"_error"} = $parsExtKeyUsage->error;
719 0         0 return undef;
720             }
721 1 50       6 $ext->{'oids'} = [ map { $oid2extkeyusage{$_} || $_ } @$oids ];
  2         8  
722 1 50       7 if ( $ext->{'critical'} ) { unshift @{ $ext->{'oids'} }, "critical"; } # mark as critical, if appropriate
  0         0  
  0         0  
723 1         6 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 2 my $self = shift;
746 1         2 my $ext;
747 1         2 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       10 if ( $ext->{'extnID'} eq '2.5.29.17' ) { #OID for SubjectAltName
752 1         2 my $parsSubjAlt = _init('SubjectAltName'); # get a parser for this
753 1         4 my $altnames = $parsSubjAlt->decode( $ext->{'extnValue'} ); # decode the value
754 1 50       115 if ( $parsSubjAlt->error ) {
755 0         0 $self->{"_error"} = $parsSubjAlt->error;
756 0         0 return undef;
757             }
758 1         5 $ext->{'names'} = [];
759 1         2 foreach my $name ( @{$altnames} ) {
  1         2  
760 1         2 foreach my $value ( keys %{$name} ) {
  1         2  
761 1         2 push @{ $ext->{'names'} }, "$value=" . $name->{$value};
  1         4  
762             }
763             }
764 1         7 return $ext->{'names'};
765             }
766             }
767 0         0 return undef;
768             }
769             #########################################################################
770             # accessors - authorityCertIssuer
771             #########################################################################
772             sub _AuthorityKeyIdentifier {
773 7     7   8 my $self = shift;
774 7         8 my $ext;
775 7         10 my $exts = $self->{'tbsCertificate'}->{'extensions'};
776 7 50       16 if ( !defined $exts ) { return undef; }
  0         0  
777             ; # no extensions in certificate
778 7 100       14 if ( defined $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} ) {
779 6         12 return ( $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} );
780             }
781 1         1 foreach $ext ( @{$exts} ) {
  1         3  
782 10 100       16 if ( $ext->{'extnID'} eq '2.5.29.35' ) { #OID for AuthorityKeyIdentifier
783 1         3 my $pars = _init('AuthorityKeyIdentifier'); # get a parser for this
784 1         4 $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'} = $pars->decode( $ext->{'extnValue'} ); # decode the value
785 1 50       683 if ( $pars->error ) {
786 0         0 $self->{"_error"} = $pars->error;
787 0         0 return undef;
788             }
789 1         7 return $self->{'tbsCertificate'}{'AuthorityKeyIdentifier'};
790             }
791             }
792 0         0 return undef;
793             }
794              
795             =head2 authorityCertIssuer
796              
797             returns a pointer to an array of strings building the DN of the Authority Cert
798             Issuer. Attributenames for the most common Attributes
799             are translated from the OID-Numbers, unknown numbers are output verbatim.
800             undef if the extension is not set in the certificate.
801              
802             $decoded= Crypt::X509->new($cert);
803             print "Certificate was authorised by:".join(',',@{$decoded->authorityCertIssuer})."\n";
804              
805             =cut back
806              
807             sub authorityCertIssuer {
808 1     1 1 2 my $self = shift;
809 1         2 my ( $i, $type );
810 1         3 my $rdn = _AuthorityKeyIdentifier($self);
811 1 50       3 if ( !defined($rdn) ) {
812 0         0 return (undef); # we do not have that extension
813             } else {
814 1         4 $rdn = $rdn->{'authorityCertIssuer'}[0]->{'directoryName'};
815             }
816 1         3 $rdn->{'dn'} = [];
817 1         2 my $dn = $rdn->{'dn'};
818 1         2 $rdn = $rdn->{'rdnSequence'};
819 1         2 foreach my $r ( @{$rdn} ) {
  1         3  
820 3         3 $i = @{$r}[0];
  3         5  
821 3 50       8 if ( $oid2attr{ $i->{'type'} } ) {
822 3         4 $type = $oid2attr{ $i->{'type'} };
823             } else {
824 0         0 $type = $i->{'type'};
825             }
826 3         4 my @key = keys( %{ $i->{'value'} } );
  3         8  
827 3         4 push @{$dn}, $type . "=" . $i->{'value'}->{ $key[0] };
  3         8  
828             }
829 1         6 return $dn;
830             }
831              
832             sub _authcert_part {
833 6     6   7 my $self = shift;
834 6         8 my $oid = shift;
835 6         11 my $rdn = _AuthorityKeyIdentifier($self);
836 6 50       11 if ( !defined($rdn) ) {
837 0         0 return (undef); # we do not have that extension
838             } else {
839 6         11 $rdn = $rdn->{'authorityCertIssuer'}[0]->{'directoryName'}->{'rdnSequence'};
840             }
841 6         7 foreach my $r ( @{$rdn} ) {
  6         12  
842 15         17 my $i = @{$r}[0];
  15         16  
843 15 100       31 if ( $i->{'type'} eq $oid ) {
844 3         3 my @key = keys( %{ $i->{'value'} } );
  3         8  
845 3         13 return $i->{'value'}->{ $key[0] };
846             }
847             }
848 3         10 return undef;
849             }
850              
851             =head2 authority_serial
852              
853             Returns the authority's certificate serial number.
854              
855             =cut back
856              
857             sub authority_serial {
858 0     0 1 0 my $self = shift;
859 0         0 return ( $self->_AuthorityKeyIdentifier )->{authorityCertSerialNumber};
860             }
861              
862             =head2 key_identifier
863              
864             Returns the authority key identifier or undef if it is a rooted cert
865              
866             =cut back
867              
868             sub key_identifier {
869 0     0 1 0 my $self = shift;
870 0 0       0 if ( defined $self->_AuthorityKeyIdentifier ) { return ( $self->_AuthorityKeyIdentifier )->{keyIdentifier}; }
  0         0  
871 0         0 return undef;
872             }
873              
874             =head2 authority_cn
875              
876             Returns the authority's ca.
877              
878             =cut back
879              
880             sub authority_cn {
881 1     1 1 3 my $self = shift;
882 1         4 return _authcert_part( $self, '2.5.4.3' );
883             }
884              
885             =head2 authority_country
886              
887             Returns the authority's country.
888              
889             =cut back
890              
891             sub authority_country {
892 1     1 1 2 my $self = shift;
893 1         3 return _authcert_part( $self, '2.5.4.6' );
894             }
895              
896             =head2 authority_state
897              
898             Returns the authority's state.
899              
900             =cut back
901              
902             sub authority_state {
903 1     1 1 2 my $self = shift;
904 1         3 return _authcert_part( $self, '2.5.4.8' );
905             }
906              
907             =head2 authority_locality
908              
909             Returns the authority's locality.
910              
911             =cut back
912              
913             sub authority_locality {
914 1     1 1 2 my $self = shift;
915 1         4 return _authcert_part( $self, '2.5.4.7' );
916             }
917              
918             =head2 authority_org
919              
920             Returns the authority's organization.
921              
922             =cut back
923              
924             sub authority_org {
925 1     1 1 2 my $self = shift;
926 1         3 return _authcert_part( $self, '2.5.4.10' );
927             }
928              
929             =head2 authority_email
930              
931             Returns the authority's email.
932              
933             =cut back
934              
935             sub authority_email {
936 1     1 1 2 my $self = shift;
937 1         3 return _authcert_part( $self, '1.2.840.113549.1.9.1' );
938             }
939              
940             =head2 CRLDistributionPoints
941              
942             Returns the CRL distribution points as an array of strings (with one value usually)
943              
944             =cut back
945              
946             sub CRLDistributionPoints {
947 1     1 1 2 my $self = shift;
948 1         2 my $ext;
949 1         3 my $exts = $self->{'tbsCertificate'}->{'extensions'};
950 1 50       4 if ( !defined $exts ) { return undef; }
  0         0  
951             ; # no extensions in certificate
952 1         3 foreach $ext ( @{$exts} ) {
  1         2  
953 2 100       6 if ( $ext->{'extnID'} eq '2.5.29.31' ) { #OID for cRLDistributionPoints
954 1         3 my $crlp = _init('cRLDistributionPoints'); # get a parser for this
955 1         4 my $points = $crlp->decode( $ext->{'extnValue'} ); # decode the value
956 1         257 $points = $points->[0]->{'distributionPoint'}->{'fullName'};
957 1 50       4 if ( $crlp->error ) {
958 0         0 $self->{"_error"} = $crlp->error;
959 0         0 return undef;
960             }
961 1         4 foreach my $name ( @{$points} ) {
  1         2  
962 1         2 push @{ $ext->{'crlpoints'} }, $name->{'uniformResourceIdentifier'};
  1         28  
963             }
964 1         7 return $ext->{'crlpoints'};
965             }
966             }
967 0         0 return undef;
968             }
969              
970             =head2 CRLDistributionPoints2
971              
972             Returns the CRL distribution points as an array of hashes (allowing for some variations)
973              
974             =cut back
975              
976             # newer CRL
977             sub CRLDistributionPoints2 {
978 1     1 1 3 my $self = shift;
979 1         2 my %CDPs;
980 1         2 my $dp_cnt = 0; # this is a counter used to show which CDP a particular value is listed in
981 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
982 1 50       4 if ( !defined $extensions ) { return undef; }
  0         0  
983             ; # no extensions in certificate
984 1         2 for my $extension ( @{$extensions} ) {
  1         4  
985 1 50       4 if ( $extension->{'extnID'} eq '2.5.29.31' ) { # OID for ARRAY of cRLDistributionPoints
986 1         4 my $parser = _init('cRLDistributionPoints'); # get a parser for CDPs
987 1         4 my $points = $parser->decode( $extension->{'extnValue'} ); # decode the values (returns an array)
988 1         1220 for my $each_dp ( @{$points} ) { # this loops through multiple "distributionPoint" values
  1         3  
989 1         2 $dp_cnt++;
990 1         1 for my $each_fullName ( @{ $each_dp->{'distributionPoint'}->{'fullName'} } )
  1         4  
991             { # this loops through multiple "fullName" values
992 2 100       7 if ( exists $each_fullName->{directoryName} ) {
    50          
993              
994             # found a rdnSequence
995 1         3 my $rdn = join ',', reverse @{ my_CRL_rdn( $each_fullName->{directoryName}->{rdnSequence} ) };
  1         5  
996 1         4 push @{ $CDPs{$dp_cnt} }, "Directory Address: $rdn";
  1         4  
997             } elsif ( exists $each_fullName->{uniformResourceIdentifier} ) {
998              
999             # found a URI
1000 1         3 push @{ $CDPs{$dp_cnt} }, "URL: " . $each_fullName->{uniformResourceIdentifier};
  1         4  
1001             } else {
1002              
1003             # found some other type of CDP value
1004             # return undef;
1005             }
1006             }
1007             }
1008 1         37 return %CDPs;
1009             }
1010             }
1011 0         0 return undef;
1012             }
1013              
1014             sub my_CRL_rdn {
1015 1     1 0 2 my $crl_rdn = shift; # this should be the passed in 'rdnSequence' array
1016 1         2 my ( $i, $type );
1017 1         2 my $crl_dn = [];
1018 1         2 for my $part ( @{$crl_rdn} ) {
  1         3  
1019 6         6 $i = @{$part}[0];
  6         8  
1020 6 50       23 if ( $oid2attr{ $i->{'type'} } ) {
1021 6         10 $type = $oid2attr{ $i->{'type'} };
1022             } else {
1023 0         0 $type = $i->{'type'};
1024             }
1025 6         7 my @key = keys( %{ $i->{'value'} } );
  6         12  
1026 6         8 push @{$crl_dn}, $type . "=" . $i->{'value'}->{ $key[0] };
  6         59  
1027             }
1028 1         4 return $crl_dn;
1029             }
1030              
1031             =head2 CertificatePolicies
1032              
1033             Returns the CertificatePolicies as an array of strings
1034              
1035             =cut back
1036              
1037             # CertificatePolicies (another extension)
1038             sub CertificatePolicies {
1039 0     0 1 0 my $self = shift;
1040 0         0 my $extension;
1041 0         0 my $CertPolicies = [];
1042 0         0 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1043 0 0       0 if ( !defined $extensions ) { return undef; }
  0         0  
1044             ; # no extensions in certificate
1045 0         0 for $extension ( @{$extensions} ) {
  0         0  
1046 0 0       0 if ( $extension->{'extnID'} eq '2.5.29.32' ) { # OID for CertificatePolicies
1047 0         0 my $parser = _init('CertificatePolicies'); # get a parser for this
1048 0         0 my $policies = $parser->decode( $extension->{'extnValue'} ); # decode the value
1049 0         0 for my $policy ( @{$policies} ) {
  0         0  
1050 0         0 for my $key ( keys %{$policy} ) {
  0         0  
1051 0         0 push @{$CertPolicies}, "$key=" . $policy->{$key};
  0         0  
1052             }
1053             }
1054 0         0 return $CertPolicies;
1055             }
1056             }
1057 0         0 return undef;
1058             }
1059              
1060             =head2 EntrustVersionInfo
1061              
1062             Returns the EntrustVersion as a string
1063              
1064             print "Entrust Version: ", $decoded->EntrustVersion, "\n";
1065              
1066             Example Output: Entrust Version: V7.0
1067              
1068             =cut back
1069              
1070             # EntrustVersion (another extension)
1071             sub EntrustVersion {
1072 1     1 0 3 my $self = shift;
1073 1         2 my $extension;
1074 1         2 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1075 1 50       4 if ( !defined $extensions ) { return undef; }
  0         0  
1076             ; # no extensions in certificate
1077 1         2 for $extension ( @{$extensions} ) {
  1         3  
1078 7 100       14 if ( $extension->{'extnID'} eq '1.2.840.113533.7.65.0' ) { # OID for EntrustVersionInfo
1079 1         3 my $parser = _init('EntrustVersionInfo'); # get a parser for this
1080 1         4 my $entrust = $parser->decode( $extension->{'extnValue'} ); # decode the value
1081 1         129 return $entrust->{'entrustVers'};
1082              
1083             # not doing anything with the EntrustInfoFlags BIT STRING (yet)
1084             # $entrust->{'entrustInfoFlags'}
1085             }
1086             }
1087 0         0 return undef;
1088             }
1089              
1090             =head2 SubjectDirectoryAttributes
1091              
1092             Returns the SubjectDirectoryAttributes as an array of key = value pairs, to include a data type
1093              
1094             print "Subject Directory Attributes: ", join( ', ' , @{ $decoded->SubjectDirectoryAttributes } ), "\n";
1095              
1096             Example Output: Subject Directory Attributes: 1.2.840.113533.7.68.29 = 7 (integer)
1097              
1098             =cut back
1099              
1100             # SubjectDirectoryAttributes (another extension)
1101             sub SubjectDirectoryAttributes {
1102 0     0 1 0 my $self = shift;
1103 0         0 my $extension;
1104 0         0 my $attributes = [];
1105 0         0 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1106 0 0       0 if ( !defined $extensions ) { return undef; }
  0         0  
1107             ; # no extensions in certificate
1108 0         0 for $extension ( @{$extensions} ) {
  0         0  
1109 0 0       0 if ( $extension->{'extnID'} eq '2.5.29.9' ) { # OID for SubjectDirectoryAttributes
1110 0         0 my $parser = _init('SubjectDirectoryAttributes'); # get a parser for this
1111 0         0 my $subject_dir_attrs = $parser->decode( $extension->{'extnValue'} ); # decode the value
1112 0         0 for my $type ( @{$subject_dir_attrs} ) {
  0         0  
1113 0         0 for my $value ( @{ $type->{'values'} } ) {
  0         0  
1114 0         0 for my $key ( keys %{$value} ) {
  0         0  
1115 0         0 push @{$attributes}, $type->{'type'} . " = " . $value->{$key} . " ($key)";
  0         0  
1116             }
1117             }
1118             }
1119 0         0 return $attributes;
1120             }
1121             }
1122 0         0 return undef;
1123             }
1124              
1125             =head2 BasicConstraints
1126              
1127             Returns the BasicConstraints as an array and the criticallity pre-pended.
1128              
1129             =cut back
1130              
1131             # BasicConstraints (another extension)
1132             sub BasicConstraints {
1133 1     1 1 3 my $self = shift;
1134 1         2 my $extension;
1135 1         2 my $constraints = [];
1136 1         2 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1137 1 50       4 if ( !defined $extensions ) { return undef; }
  0         0  
1138             ; # no extensions in certificate
1139 1         2 for $extension ( @{$extensions} ) {
  1         3  
1140 2 100       6 if ( $extension->{'extnID'} eq '2.5.29.19' ) { # OID for BasicConstraints
1141 1 50       3 if ( $extension->{'critical'} ) { push @{$constraints}, "critical"; } # mark this as critical as appropriate
  1         2  
  1         3  
1142 1         3 my $parser = _init('BasicConstraints'); # get a parser for this
1143 1         3 my $basic_constraints = $parser->decode( $extension->{'extnValue'} ); # decode the value
1144 1         108 for my $key ( keys %{$basic_constraints} ) {
  1         3  
1145 1         2 push @{$constraints}, "$key = " . $basic_constraints->{$key};
  1         4  
1146             }
1147 1         8 return $constraints;
1148             }
1149             }
1150 0         0 return undef;
1151             }
1152              
1153             =head2 subject_keyidentifier
1154              
1155             Returns the subject key identifier from the extensions.
1156              
1157             =cut back
1158              
1159             # subject_keyidentifier (another extension)
1160             sub subject_keyidentifier {
1161 1     1 1 466 my $self = shift;
1162 1         5 return $self->_SubjectKeyIdentifier;
1163             }
1164              
1165             # _SubjectKeyIdentifier (another extension)
1166             sub _SubjectKeyIdentifier {
1167 1     1   1 my $self = shift;
1168 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1169 1 50       4 if ( !defined $extensions ) { return undef; }
  0         0  
1170             ; # no extensions in certificate
1171 1 50       3 if ( defined $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} ) {
1172 0         0 return ( $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} );
1173             }
1174 1         2 for my $extension ( @{$extensions} ) {
  1         3  
1175 4 100       8 if ( $extension->{'extnID'} eq '2.5.29.14' ) { # OID for SubjectKeyIdentifier
1176 1         3 my $parser = _init('SubjectKeyIdentifier'); # get a parser for this
1177 1         3 $self->{'tbsCertificate'}{'SubjectKeyIdentifier'} = $parser->decode( $extension->{'extnValue'} ); # decode the value
1178 1 50       64 if ( $parser->error ) {
1179 0         0 $self->{"_error"} = $parser->error;
1180 0         0 return undef;
1181             }
1182 1         9 return $self->{'tbsCertificate'}{'SubjectKeyIdentifier'};
1183             }
1184             }
1185 0         0 return undef;
1186             }
1187              
1188             =head2 SubjectInfoAccess
1189              
1190             Returns the SubjectInfoAccess as an array of hashes with key=value pairs.
1191              
1192             print "Subject Info Access: ";
1193             if ( defined $decoded->SubjectInfoAccess ) {
1194             my %SIA = $decoded->SubjectInfoAccess;
1195             for my $key ( keys %SIA ) {
1196             print "\n\t$key: \n\t";
1197             print join( "\n\t" , @{ $SIA{$key} } ), "\n";
1198             }
1199             } else { print "\n" }
1200              
1201             Example Output:
1202             Subject Info Access:
1203             1.3.6.1.5.5.7.48.5:
1204             uniformResourceIdentifier = http://pki.treas.gov/root_sia.p7c
1205             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
1206              
1207             =cut back
1208              
1209             # SubjectInfoAccess (another extension)
1210             sub SubjectInfoAccess {
1211 1     1 1 3 my $self = shift;
1212 1         2 my $extension;
1213             my %SIA;
1214 1         2 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1215 1 50       5 if ( !defined $extensions ) { return undef; }
  0         0  
1216             ; # no extensions in certificate
1217 1         2 for $extension ( @{$extensions} ) {
  1         3  
1218 3 100       7 if ( $extension->{'extnID'} eq '1.3.6.1.5.5.7.1.11' ) { # OID for SubjectInfoAccess
1219 1         3 my $parser = _init('SubjectInfoAccessSyntax'); # get a parser for this
1220 1         4 my $subject_info_access = $parser->decode( $extension->{'extnValue'} ); # decode the value
1221 1         339 for my $sia ( @{$subject_info_access} ) {
  1         4  
1222 2         2 for my $key ( keys %{ $sia->{'accessLocation'} } ) {
  2         6  
1223 2         3 push @{ $SIA{ $sia->{'accessMethod'} } }, "$key = " . $sia->{'accessLocation'}{$key};
  2         9  
1224             }
1225             }
1226 1         7 return %SIA;
1227             }
1228             }
1229 0         0 return undef;
1230             }
1231              
1232              
1233             =head2 PGPExtension
1234              
1235             Returns the creation timestamp of the corresponding OpenPGP key.
1236             (see http://www.imc.org/ietf-openpgp/mail-archive/msg05320.html)
1237              
1238             print "PGPExtension: ";
1239             if ( defined $decoded->PGPExtension ) {
1240             my $creationtime = $decoded->PGPExtension;
1241             printf "\n\tcorresponding OpenPGP Creation Time: ", $creationtime, "\n";
1242             }
1243              
1244             Example Output:
1245             PGPExtension:
1246             whatever
1247              
1248             =cut back
1249              
1250             # PGPExtension (another extension)
1251             sub PGPExtension {
1252 1     1 1 3 my $self = shift;
1253 1         2 my $extension;
1254 1         3 my $extensions = $self->{'tbsCertificate'}->{'extensions'};
1255 1 50       4 if ( !defined $extensions ) { return undef; }
  0         0  
1256             ; # no extensions in certificate
1257 1         2 for $extension ( @{$extensions} ) {
  1         3  
1258 6 100       11 if ( $extension->{'extnID'} eq '1.3.6.1.4.1.3401.8.1.1' ) { # OID for PGPExtension
1259 1         4 my $parser = _init('PGPExtension'); # get a parser for this
1260 1         5 my $pgpextension = $parser->decode( $extension->{'extnValue'} ); # decode the value
1261 1 50       193 if ($pgpextension->{version} != 0) {
1262 0         0 $self->{"_error"} = sprintf("got PGPExtension version %d. We only know how to deal with v1 (0)", $pgpextension->{version});
1263             } else {
1264 1         3 foreach my $timetype ('generalTime', 'utcTime') {
1265             return $pgpextension->{keyCreation}->{$timetype}
1266 1 50       16 if exists $pgpextension->{keyCreation}->{$timetype};
1267             }
1268             }
1269             }
1270             }
1271 0         0 return undef;
1272             }
1273              
1274             #######################################################################
1275             # internal functions
1276             #######################################################################
1277             sub _init {
1278 17     17   27 my $what = shift;
1279 17 100 66     74 if ( ( !defined $what ) || ( '' eq $what ) ) { $what = 'Certificate' }
  2         3  
1280 17 100       34 if ( !defined $asn ) {
1281 1         8 $asn = Convert::ASN1->new;
1282 1         38 $asn->prepare(<
1283             -- ASN.1 from RFC2459 and X.509(2001)
1284             -- Adapted for use with Convert::ASN1
1285             -- Id: x509decode,v 1.1 2002/02/10 16:41:28 gbarr Exp
1286              
1287             -- attribute data types --
1288              
1289             Attribute ::= SEQUENCE {
1290             type AttributeType,
1291             values SET OF AttributeValue
1292             -- at least one value is required --
1293             }
1294              
1295             AttributeType ::= OBJECT IDENTIFIER
1296              
1297             AttributeValue ::= DirectoryString --ANY
1298              
1299             AttributeTypeAndValue ::= SEQUENCE {
1300             type AttributeType,
1301             value AttributeValue
1302             }
1303              
1304              
1305             -- naming data types --
1306              
1307             Name ::= CHOICE { -- only one possibility for now
1308             rdnSequence RDNSequence
1309             }
1310              
1311             RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
1312              
1313             DistinguishedName ::= RDNSequence
1314              
1315             RelativeDistinguishedName ::=
1316             SET OF AttributeTypeAndValue --SET SIZE (1 .. MAX) OF
1317              
1318              
1319             -- Directory string type --
1320              
1321             DirectoryString ::= CHOICE {
1322             teletexString TeletexString, --(SIZE (1..MAX)),
1323             printableString PrintableString, --(SIZE (1..MAX)),
1324             bmpString BMPString, --(SIZE (1..MAX)),
1325             universalString UniversalString, --(SIZE (1..MAX)),
1326             utf8String UTF8String, --(SIZE (1..MAX)),
1327             ia5String IA5String, --added for EmailAddress,
1328             integer INTEGER
1329             }
1330              
1331              
1332             -- certificate and CRL specific structures begin here
1333              
1334             Certificate ::= SEQUENCE {
1335             tbsCertificate TBSCertificate,
1336             signatureAlgorithm AlgorithmIdentifier,
1337             signature BIT STRING
1338             }
1339              
1340             TBSCertificate ::= SEQUENCE {
1341             version [0] EXPLICIT Version OPTIONAL, --DEFAULT v1
1342             serialNumber CertificateSerialNumber,
1343             signature AlgorithmIdentifier,
1344             issuer Name,
1345             validity Validity,
1346             subject Name,
1347             subjectPublicKeyInfo SubjectPublicKeyInfo,
1348             issuerUniqueID [1] IMPLICIT UniqueIdentifier OPTIONAL,
1349             -- If present, version shall be v2 or v3
1350             subjectUniqueID [2] IMPLICIT UniqueIdentifier OPTIONAL,
1351             -- If present, version shall be v2 or v3
1352             extensions [3] EXPLICIT Extensions OPTIONAL
1353             -- If present, version shall be v3
1354             }
1355              
1356             Version ::= INTEGER --{ v1(0), v2(1), v3(2) }
1357              
1358             CertificateSerialNumber ::= INTEGER
1359              
1360             Validity ::= SEQUENCE {
1361             notBefore Time,
1362             notAfter Time
1363             }
1364              
1365             Time ::= CHOICE {
1366             utcTime UTCTime,
1367             generalTime GeneralizedTime
1368             }
1369              
1370             UniqueIdentifier ::= BIT STRING
1371              
1372             SubjectPublicKeyInfo ::= SEQUENCE {
1373             algorithm AlgorithmIdentifier,
1374             subjectPublicKey BIT STRING
1375             }
1376              
1377              
1378             RSAPubKeyInfo ::= SEQUENCE {
1379             modulus INTEGER,
1380             exponent INTEGER
1381             }
1382              
1383             Extensions ::= SEQUENCE OF Extension --SIZE (1..MAX) OF Extension
1384              
1385             Extension ::= SEQUENCE {
1386             extnID OBJECT IDENTIFIER,
1387             critical BOOLEAN OPTIONAL, --DEFAULT FALSE,
1388             extnValue OCTET STRING
1389             }
1390              
1391             AlgorithmIdentifier ::= SEQUENCE {
1392             algorithm OBJECT IDENTIFIER,
1393             parameters ANY OPTIONAL
1394             }
1395              
1396              
1397             --extensions
1398              
1399             AuthorityKeyIdentifier ::= SEQUENCE {
1400             keyIdentifier [0] KeyIdentifier OPTIONAL,
1401             authorityCertIssuer [1] GeneralNames OPTIONAL,
1402             authorityCertSerialNumber [2] CertificateSerialNumber OPTIONAL }
1403             -- authorityCertIssuer and authorityCertSerialNumber shall both
1404             -- be present or both be absent
1405              
1406             KeyIdentifier ::= OCTET STRING
1407              
1408             SubjectKeyIdentifier ::= KeyIdentifier
1409              
1410             -- key usage extension OID and syntax
1411              
1412             -- id-ce-keyUsage OBJECT IDENTIFIER ::= { id-ce 15 }
1413              
1414             KeyUsage ::= BIT STRING --{
1415             -- digitalSignature (0),
1416             -- nonRepudiation (1),
1417             -- keyEncipherment (2),
1418             -- dataEncipherment (3),
1419             -- keyAgreement (4),
1420             -- keyCertSign (5),
1421             -- cRLSign (6),
1422             -- encipherOnly (7),
1423             -- decipherOnly (8) }
1424              
1425              
1426             -- private key usage period extension OID and syntax
1427              
1428             -- id-ce-privateKeyUsagePeriod OBJECT IDENTIFIER ::= { id-ce 16 }
1429              
1430             PrivateKeyUsagePeriod ::= SEQUENCE {
1431             notBefore [0] GeneralizedTime OPTIONAL,
1432             notAfter [1] GeneralizedTime OPTIONAL }
1433             -- either notBefore or notAfter shall be present
1434              
1435             -- certificate policies extension OID and syntax
1436             -- id-ce-certificatePolicies OBJECT IDENTIFIER ::= { id-ce 32 }
1437              
1438             CertificatePolicies ::= SEQUENCE OF PolicyInformation
1439              
1440             PolicyInformation ::= SEQUENCE {
1441             policyIdentifier CertPolicyId,
1442             policyQualifiers SEQUENCE OF
1443             PolicyQualifierInfo OPTIONAL }
1444              
1445             CertPolicyId ::= OBJECT IDENTIFIER
1446              
1447             PolicyQualifierInfo ::= SEQUENCE {
1448             policyQualifierId PolicyQualifierId,
1449             qualifier ANY } --DEFINED BY policyQualifierId }
1450              
1451             -- Implementations that recognize additional policy qualifiers shall
1452             -- augment the following definition for PolicyQualifierId
1453              
1454             PolicyQualifierId ::=
1455             OBJECT IDENTIFIER --( id-qt-cps | id-qt-unotice )
1456              
1457             -- CPS pointer qualifier
1458              
1459             CPSuri ::= IA5String
1460              
1461             -- user notice qualifier
1462              
1463             UserNotice ::= SEQUENCE {
1464             noticeRef NoticeReference OPTIONAL,
1465             explicitText DisplayText OPTIONAL}
1466              
1467             NoticeReference ::= SEQUENCE {
1468             organization DisplayText,
1469             noticeNumbers SEQUENCE OF INTEGER }
1470              
1471             DisplayText ::= CHOICE {
1472             visibleString VisibleString ,
1473             bmpString BMPString ,
1474             utf8String UTF8String }
1475              
1476              
1477             -- policy mapping extension OID and syntax
1478             -- id-ce-policyMappings OBJECT IDENTIFIER ::= { id-ce 33 }
1479              
1480             PolicyMappings ::= SEQUENCE OF SEQUENCE {
1481             issuerDomainPolicy CertPolicyId,
1482             subjectDomainPolicy CertPolicyId }
1483              
1484              
1485             -- subject alternative name extension OID and syntax
1486             -- id-ce-subjectAltName OBJECT IDENTIFIER ::= { id-ce 17 }
1487              
1488             SubjectAltName ::= GeneralNames
1489              
1490             GeneralNames ::= SEQUENCE OF GeneralName
1491              
1492             GeneralName ::= CHOICE {
1493             otherName [0] AnotherName,
1494             rfc822Name [1] IA5String,
1495             dNSName [2] IA5String,
1496             x400Address [3] ANY, --ORAddress,
1497             directoryName [4] Name,
1498             ediPartyName [5] EDIPartyName,
1499             uniformResourceIdentifier [6] IA5String,
1500             iPAddress [7] OCTET STRING,
1501             registeredID [8] OBJECT IDENTIFIER }
1502              
1503             EntrustVersionInfo ::= SEQUENCE {
1504             entrustVers GeneralString,
1505             entrustInfoFlags EntrustInfoFlags }
1506              
1507             EntrustInfoFlags::= BIT STRING --{
1508             -- keyUpdateAllowed
1509             -- newExtensions (1), -- not used
1510             -- pKIXCertificate (2) } -- certificate created by pkix
1511              
1512             -- AnotherName replaces OTHER-NAME ::= TYPE-IDENTIFIER, as
1513             -- TYPE-IDENTIFIER is not supported in the 88 ASN.1 syntax
1514              
1515             AnotherName ::= SEQUENCE {
1516             type OBJECT IDENTIFIER,
1517             value [0] EXPLICIT ANY } --DEFINED BY type-id }
1518              
1519             EDIPartyName ::= SEQUENCE {
1520             nameAssigner [0] DirectoryString OPTIONAL,
1521             partyName [1] DirectoryString }
1522              
1523              
1524             -- issuer alternative name extension OID and syntax
1525             -- id-ce-issuerAltName OBJECT IDENTIFIER ::= { id-ce 18 }
1526              
1527             IssuerAltName ::= GeneralNames
1528              
1529              
1530             -- id-ce-subjectDirectoryAttributes OBJECT IDENTIFIER ::= { id-ce 9 }
1531              
1532             SubjectDirectoryAttributes ::= SEQUENCE OF Attribute
1533              
1534              
1535             -- basic constraints extension OID and syntax
1536             -- id-ce-basicConstraints OBJECT IDENTIFIER ::= { id-ce 19 }
1537              
1538             BasicConstraints ::= SEQUENCE {
1539             cA BOOLEAN OPTIONAL, --DEFAULT FALSE,
1540             pathLenConstraint INTEGER OPTIONAL }
1541              
1542              
1543             -- name constraints extension OID and syntax
1544             -- id-ce-nameConstraints OBJECT IDENTIFIER ::= { id-ce 30 }
1545              
1546             NameConstraints ::= SEQUENCE {
1547             permittedSubtrees [0] GeneralSubtrees OPTIONAL,
1548             excludedSubtrees [1] GeneralSubtrees OPTIONAL }
1549              
1550             GeneralSubtrees ::= SEQUENCE OF GeneralSubtree
1551              
1552             GeneralSubtree ::= SEQUENCE {
1553             base GeneralName,
1554             minimum [0] BaseDistance OPTIONAL, --DEFAULT 0,
1555             maximum [1] BaseDistance OPTIONAL }
1556              
1557             BaseDistance ::= INTEGER
1558              
1559              
1560             -- policy constraints extension OID and syntax
1561             -- id-ce-policyConstraints OBJECT IDENTIFIER ::= { id-ce 36 }
1562              
1563             PolicyConstraints ::= SEQUENCE {
1564             requireExplicitPolicy [0] SkipCerts OPTIONAL,
1565             inhibitPolicyMapping [1] SkipCerts OPTIONAL }
1566              
1567             SkipCerts ::= INTEGER
1568              
1569              
1570             -- CRL distribution points extension OID and syntax
1571             -- id-ce-cRLDistributionPoints OBJECT IDENTIFIER ::= {id-ce 31}
1572              
1573             cRLDistributionPoints ::= SEQUENCE OF DistributionPoint
1574              
1575             DistributionPoint ::= SEQUENCE {
1576             distributionPoint [0] DistributionPointName OPTIONAL,
1577             reasons [1] ReasonFlags OPTIONAL,
1578             cRLIssuer [2] GeneralNames OPTIONAL }
1579              
1580             DistributionPointName ::= CHOICE {
1581             fullName [0] GeneralNames,
1582             nameRelativeToCRLIssuer [1] RelativeDistinguishedName }
1583              
1584             ReasonFlags ::= BIT STRING --{
1585             -- unused (0),
1586             -- keyCompromise (1),
1587             -- cACompromise (2),
1588             -- affiliationChanged (3),
1589             -- superseded (4),
1590             -- cessationOfOperation (5),
1591             -- certificateHold (6),
1592             -- privilegeWithdrawn (7),
1593             -- aACompromise (8) }
1594              
1595              
1596             -- extended key usage extension OID and syntax
1597             -- id-ce-extKeyUsage OBJECT IDENTIFIER ::= {id-ce 37}
1598              
1599             ExtKeyUsageSyntax ::= SEQUENCE OF KeyPurposeId
1600              
1601             KeyPurposeId ::= OBJECT IDENTIFIER
1602              
1603             -- extended key purpose OIDs
1604             -- id-kp-serverAuth OBJECT IDENTIFIER ::= { id-kp 1 }
1605             -- id-kp-clientAuth OBJECT IDENTIFIER ::= { id-kp 2 }
1606             -- id-kp-codeSigning OBJECT IDENTIFIER ::= { id-kp 3 }
1607             -- id-kp-emailProtection OBJECT IDENTIFIER ::= { id-kp 4 }
1608             -- id-kp-ipsecEndSystem OBJECT IDENTIFIER ::= { id-kp 5 }
1609             -- id-kp-ipsecTunnel OBJECT IDENTIFIER ::= { id-kp 6 }
1610             -- id-kp-ipsecUser OBJECT IDENTIFIER ::= { id-kp 7 }
1611             -- id-kp-timeStamping OBJECT IDENTIFIER ::= { id-kp 8 }
1612              
1613             -- authority info access
1614              
1615             -- id-pe-authorityInfoAccess OBJECT IDENTIFIER ::= { id-pe 1 }
1616              
1617             AuthorityInfoAccessSyntax ::=
1618             SEQUENCE OF AccessDescription --SIZE (1..MAX) OF AccessDescription
1619              
1620             AccessDescription ::= SEQUENCE {
1621             accessMethod OBJECT IDENTIFIER,
1622             accessLocation GeneralName }
1623              
1624             -- subject info access
1625              
1626             -- id-pe-subjectInfoAccess OBJECT IDENTIFIER ::= { id-pe 11 }
1627              
1628             SubjectInfoAccessSyntax ::=
1629             SEQUENCE OF AccessDescription --SIZE (1..MAX) OF AccessDescription
1630              
1631             -- pgp creation time
1632              
1633             PGPExtension ::= SEQUENCE {
1634             version Version, -- DEFAULT v1(0)
1635             keyCreation Time
1636             }
1637             ASN1
1638             }
1639 17         50174 my $self = $asn->find($what);
1640 17         224 return $self;
1641             }
1642              
1643             =head1 SEE ALSO
1644              
1645             See the examples of C and the Mailing List.
1646             An example on how to load certificates can be found in F.
1647              
1648             =head1 ACKNOWLEDGEMENTS
1649              
1650             This module is based on the x509decode script, which was contributed to
1651             Convert::ASN1 in 2002 by Norbert Klasen.
1652              
1653             =head1 AUTHORS
1654              
1655             Mike Jackson ,
1656             Alexander Jung ,
1657             Duncan Segrest
1658             Oliver Welter
1659              
1660             =head1 COPYRIGHT
1661              
1662             Copyright (c) 2005 Mike Jackson .
1663             Copyright (c) 2001-2002 Norbert Klasen, DAASI International GmbH.
1664              
1665             All rights reserved. This program is free software; you can redistribute
1666             it and/or modify it under the same terms as Perl itself.
1667              
1668             =cut
1669             1;
1670             __END__