File Coverage

lib/Crypt/Perl/X509/Extension/certificatePolicies.pm
Criterion Covered Total %
statement 48 49 97.9
branch 7 10 70.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 0 1 0.0
total 65 71 91.5


line stmt bran cond sub pod time code
1             package Crypt::Perl::X509::Extension::certificatePolicies;
2              
3 1     1   706 use strict;
  1         2  
  1         33  
4 1     1   5 use warnings;
  1         2  
  1         39  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Crypt::Perl::X509::Extension::certificatePolicies
11              
12             =head1 SYNOPSIS
13              
14             Crypt::Perl::X509::Extension::certificatePolicies->new(
15             [ 'domain-validated' ],
16             [ '1.3.6.1.4.1.6449.1.2.2.52',
17             [ cps => 'http://cps.url' ],
18             [ cps => 'http://cps.url2' ],
19             ],
20             [ '1.2.3.4.5.6.7.8',
21             [ unotice => {
22              
23             #NB: “Conforming CAs SHOULD NOT use the noticeRef option.”
24             noticeRef => {
25             organization => 'FooFoo',
26             noticeNumbers => [ 12, 23, 34 ],
27             },
28              
29             explicitText => 'apple',
30             } ],
31             ],
32             );
33              
34             =cut
35              
36 1     1   5 use parent qw( Crypt::Perl::X509::Extension );
  1         2  
  1         8  
37              
38 1     1   57 use Crypt::Perl::X ();
  1         1  
  1         17  
39              
40 1     1   4 use constant OID => '2.5.29.32';
  1         1  
  1         85  
41              
42 1     1   5 use constant ASN1 => <
  1         2  
  1         418  
43             certificatePolicies ::= SEQUENCE OF PolicyInformation
44              
45             PolicyInformation ::= SEQUENCE {
46             policyIdentifier OBJECT IDENTIFIER,
47             policyQualifiers SEQUENCE OF PolicyQualifierInfo OPTIONAL
48             }
49              
50             PolicyQualifierInfo ::= SEQUENCE {
51             policyQualifierId OBJECT IDENTIFIER,
52             qualifier ANY -- DEFINED BY policyQualifierId
53             }
54              
55             cpsValue ::= IA5String
56              
57             unoticeValue ::= SEQUENCE {
58             noticeRef NoticeReference OPTIONAL,
59             explicitText DisplayText OPTIONAL
60             }
61              
62             NoticeReference ::= SEQUENCE {
63             organization DisplayText,
64             noticeNumbers SEQUENCE OF INTEGER
65             }
66              
67             DisplayText ::= CHOICE {
68             -- ia5String IA5String (SIZE (1..200)),
69             -- visibleString VisibleString (SIZE (1..200)),
70             -- bmpString BMPString (SIZE (1..200)),
71             utf8String UTF8String -- (SIZE (1..200))
72             }
73             END
74              
75             my %qual_oid = (
76             cps => '1.3.6.1.5.5.7.2.1',
77             unotice => '1.3.6.1.5.5.7.2.2',
78             );
79              
80             my %policy_oid = (
81             'domain-validated' => '2.23.140.1.2.1',
82             'organization-validated' => '2.23.140.1.2.2',
83             );
84              
85             sub new {
86 6     6 0 33 my ($class, @policies) = @_;
87              
88 6 50       36 if (!@policies) {
89 0         0 die Crypt::Perl::X::create('Generic', 'Need policies!');
90             }
91              
92 6         95 return bless \@policies, $class;
93             }
94              
95             sub _encode_params {
96 6     6   27 my ($self) = @_;
97              
98 6         14 my @data;
99              
100 6         40 for my $p (@$self) {
101 12         49 my ( $p_oid, @quals ) = @$p;
102              
103             my $item = {
104 12   66     126 policyIdentifier => $policy_oid{$p_oid} || $p_oid,
105             };
106 12         62 push @data, $item;
107              
108 12 100       42 if (@quals) {
109 6         21 my @iquals;
110 6         17 $item->{'policyQualifiers'} = \@iquals;
111              
112 6         19 for my $q (@quals) {
113 12         45 my $q_oid = $q->[0];
114              
115 12         47 my $asn1 = Crypt::Perl::ASN1->new()->prepare($self->ASN1());
116 12         77 $asn1 = $asn1->find( "${q_oid}Value" );
117              
118 12         196 my $val;
119 12 100       42 if ( $q_oid eq 'unotice' ) {
120 6         16 $val = { %{ $q->[1] } };
  6         31  
121              
122 6 50       23 if ($val->{'noticeRef'}) {
123 6         30 $val->{'noticeRef'} = { %{ $val->{'noticeRef'} } };
  6         47  
124             $val->{'noticeRef'}{'organization'} = {
125 6         26 utf8String => $val->{'noticeRef'}{'organization'},
126             };
127             }
128              
129 6 50       24 if ($val->{'explicitText'}) {
130             $val->{'explicitText'} = {
131 6         18 utf8String => $val->{'explicitText'},
132             };
133             }
134             }
135             else {
136 6         34 $val = $q->[1];
137             }
138              
139 12         45 $val = $asn1->encode( $val );
140              
141             push @iquals, {
142 12         2448 policyQualifierId => $qual_oid{$q_oid},
143             qualifier => $val,
144             };
145             }
146             }
147             }
148              
149 6         30 return \@data;
150             }
151              
152             1;