File Coverage

lib/Crypt/Perl/X509v3.pm
Criterion Covered Total %
statement 79 86 91.8
branch 14 24 58.3
condition 3 8 37.5
subroutine 14 14 100.0
pod 0 3 0.0
total 110 135 81.4


line stmt bran cond sub pod time code
1             package Crypt::Perl::X509v3;
2              
3 1     1   419 use strict;
  1         2  
  1         23  
4 1     1   5 use warnings;
  1         1  
  1         29  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Crypt::Perl::X509v3 - TLS/SSL Certificates
11              
12             =head1 SYNOPSIS
13              
14             my $cert = Crypt::Perl::X509v3->new(
15             key => $crypt_perl_public_key_obj,
16             issuer => [
17             [ commonName => 'Foo', surname => 'theIssuer' ],
18             [ givenName => 'separate RDNs' ],
19             ],
20             subject => \@subject, #same format as issuer
21              
22             not_before => $unixtime,
23             not_after => $unixtime,
24              
25             # The same structure as in Crypt::Perl::PKCS10 …
26             extensions => [
27             [ keyUsage => 'keyCertSign', 'keyEncipherment' ],
28             [ $extn_name => @extn_args ],
29             # ..
30             ],
31              
32             serial_number => 12345,
33              
34             issuer_unique_id => '..',
35             subject_unique_id => '..',
36             );
37              
38             $cert->sign( $crypt_perl_private_key_obj, 'sha256' );
39              
40             my $pem = $cert->to_pem();
41              
42             =head1 STATUS
43              
44             This module is B! The API may change between versions.
45             If you’re going to build something off of it, ensure that you check
46             Crypt::Perl’s changelog before updating this module.
47              
48             =head1 DESCRIPTION
49              
50             This module can create TLS/SSL certificates. The caller has full control
51             over all certificate components, and anything not specified is not assumed.
52              
53             There currently is not a parsing interface. Hopefully that can be remedied.
54              
55             =cut
56              
57 1     1   4 use parent qw( Crypt::Perl::ASN1::Encodee );
  1         1  
  1         5  
58              
59 1     1   488 use Digest::SHA ();
  1         2338  
  1         22  
60              
61 1     1   361 use Crypt::Perl::ASN1::Signatures ();
  1         3  
  1         49  
62 1     1   392 use Crypt::Perl::X509::Extensions ();
  1         4  
  1         16  
63 1     1   369 use Crypt::Perl::X509::Name ();
  1         2  
  1         17  
64              
65 1     1   6 use Crypt::Perl::X ();
  1         1  
  1         74  
66              
67             #TODO: refactor
68             *to_der = __PACKAGE__->can('encode');
69              
70             sub to_pem {
71 6     6 0 41 my ($self) = @_;
72              
73 6         32 return Crypt::Format::der2pem( $self->to_der(), 'CERTIFICATE' );
74             }
75              
76 1     1   4 use constant ASN1 => <
  1         1  
  1         775  
77             X509v3 ::= SEQUENCE {
78             tbsCertificate ANY,
79             signatureAlgorithm SigIdentifier,
80             signature BIT STRING
81             }
82              
83             SigIdentifier ::= SEQUENCE {
84             algorithm OBJECT IDENTIFIER,
85             parameters ANY OPTIONAL
86             }
87              
88             TBSCertificate ::= SEQUENCE {
89             version [0] Version,
90             serialNumber INTEGER,
91             signature SigIdentifier,
92             issuer ANY, -- Name
93             validity Validity,
94             subject ANY, -- Name
95             subjectPublicKeyInfo ANY,
96             issuerUniqueID [1] IMPLICIT BIT STRING OPTIONAL,
97             -- If present, version MUST be v2 or v3
98             subjectUniqueID [2] IMPLICIT BIT STRING OPTIONAL,
99             -- If present, version MUST be v2 or v3
100             extensions [3] Extensions OPTIONAL
101             -- If present, version MUST be v3 --
102             }
103              
104             Version ::= SEQUENCE {
105             version INTEGER
106             }
107              
108             Validity ::= SEQUENCE {
109             notBefore Time,
110             notAfter Time
111             }
112              
113             Time ::= CHOICE {
114             -- utcTime UTCTime, -- Y2K problem … wtf?!?
115             generalTime GeneralizedTime
116             }
117              
118             Extensions ::= SEQUENCE {
119             extensions ANY
120             }
121             END
122              
123             sub new {
124 6     6 0 419 my ($class, %opts) = @_;
125              
126 6         21 my @missing = grep { !$opts{$_} } qw( subject key not_after );
  18         55  
127              
128 6 50       20 if (@missing) {
129 0         0 die Crypt::Perl::X::create('Generic', "Missing: @missing");
130             }
131              
132 6   33     62 $opts{'extensions'} &&= Crypt::Perl::X509::Extensions->new(@{ $opts{'extensions'} });
  6         131  
133              
134 6         14 my $subj = Crypt::Perl::X509::Name->new( @{ $opts{'subject'} } );
  6         100  
135              
136 6         23 my $issuer;
137 6 50       35 if ($opts{'issuer'}) {
138 6         15 $issuer = Crypt::Perl::X509::Name->new( @{ $opts{'issuer'} } );
  6         26  
139             }
140             else {
141 0         0 $issuer = $subj; #self-signed
142             }
143              
144 6   50     89 $opts{'serial_number'} ||= 0;
145              
146             my %self = (
147             _subject => $subj,
148             _issuer => $issuer,
149             _not_before => $opts{'not_before'} || time,
150              
151 6   33     53 ( map { ( "_$_" => $opts{$_} ) } qw(
  36         150  
152             key
153             not_after
154             extensions
155             serial_number
156             subject_unique_id
157             issuer_unique_id
158             ) ),
159             );
160              
161 6         47 return bless \%self, $class;
162             }
163              
164             sub sign {
165 6     6 0 115 my ($self, $signer_key, $digest_algorithm) = @_;
166              
167             #This validates the digest algorithm.
168 6         50 my $tbs = $self->_encode_tbs_certificate($signer_key, $digest_algorithm);
169              
170 6         3389 my ($sig_alg, $sig_func, $signature);
171              
172 6 50       92 $digest_algorithm =~ m<([0-9]+)\z> or die "huh? ($digest_algorithm)";
173 6         50 my $digest_length = $1;
174              
175 6 100       124 if ($signer_key->isa('Crypt::Perl::ECDSA::PrivateKey')) {
    50          
176             #$sig_alg = $signer_key->get_public_key()->algorithm_identifier_with_curve_name();
177 3         12 $sig_alg = "ecdsa-with-SHA$digest_length";
178              
179 3         177 $signature = $signer_key->sign( Digest::SHA->can($digest_algorithm)->($tbs) );
180             }
181             elsif ($signer_key->isa('Crypt::Perl::RSA::PrivateKey')) {
182             #$sig_alg = $signer_key->get_public_key()->algorithm_identifier();
183 3         14 $sig_alg = "sha${digest_length}WithRSAEncryption";
184              
185 3 50       35 my $sign_cr = $signer_key->can("sign_RS$digest_length") or do {
186 0         0 die "Unsupported digest for RSA: $digest_algorithm";
187             };
188              
189 3         23 $signature = $sign_cr->($signer_key, $tbs);
190             }
191             else {
192 0         0 die "Key ($signer_key) is not a recognized private key object!";
193             }
194              
195             $sig_alg = {
196 6         95772 algorithm => $Crypt::Perl::ASN1::Signatures::OID{$sig_alg},
197             };
198              
199 6         55 $self->{'_signed'} = {
200             tbsCertificate => $tbs,
201             signatureAlgorithm => $sig_alg,
202             signature => $signature,
203             };
204              
205 6         29 return $self;
206             }
207              
208             sub _encode_params {
209 6     6   21 my ($self) = @_;
210              
211 6 50       26 if (!$self->{'_signed'}) {
212 0         0 die Crypt::Perl::X::create('Generic', 'Call sign() first!');
213             }
214              
215 6         29 return $self->{'_signed'};
216             }
217              
218             sub _encode_tbs_certificate {
219 6     6   43 my ($self, $signing_key, $digest_algorithm) = @_;
220              
221 6 50       108 $digest_algorithm =~ m<\Asha(224|256|384|512)\z> or do {
222 0         0 die Crypt::Perl::X::create('Generic', "Unknown digest algorithm: “$digest_algorithm”");
223             };
224 6         24 my $digest_length = $1;
225              
226 6         18 my $sig_alg;
227              
228             my $pubkey_der;
229              
230 6 100       120 if ($self->{'_key'}->isa('Crypt::Perl::ECDSA::PublicKey')) {
    50          
231 3         27 $pubkey_der = $self->{'_key'}->to_der_with_curve_name();
232             #$sig_alg = 'ecPublicKey'; #"ecdsa-with-SHA$digest_length";
233 3         839 $sig_alg = "ecdsa-with-SHA$digest_length";
234             }
235             elsif ($self->{'_key'}->isa('Crypt::Perl::RSA::PublicKey')) {
236 3         35 $pubkey_der = $self->{'_key'}->to_subject_der();
237             #$sig_alg = 'rsaEncryption'; #"sha${digest_length}WithRSAEncryption";
238 3         845 $sig_alg = "sha${digest_length}WithRSAEncryption";
239             }
240             else {
241 0         0 die "Key ($self->{'_key'}) is not a recognized public key object!";
242             }
243              
244 6         26 my $extns_bin;
245 6 50       31 if ($self->{'_extensions'}) {
246 6         39 $extns_bin = $self->{'_extensions'}->encode();
247             }
248              
249             my $params_hr = {
250             version => { version => 2 },
251              
252             serialNumber => $self->{'_serial_number'},
253              
254             issuerUniqueID => $self->{'_issuer_unique_id'},
255              
256             subjectUniqueID => $self->{'_subject_unique_id'},
257              
258             subject => $self->{'_subject'}->encode(),
259             issuer => $self->{'_issuer'}->encode(),
260              
261             validity => {
262             notBefore => { generalTime => $self->{'_not_before'} },
263             notAfter => { generalTime => $self->{'_not_after'} },
264             },
265              
266             subjectPublicKeyInfo => $pubkey_der,
267              
268             signature => {
269 6 50       10102 algorithm => $Crypt::Perl::ASN1::Signatures::OID{$sig_alg},
270             },
271              
272             ( $extns_bin ? ( extensions => { extensions => $extns_bin } ) : () ),
273             };
274              
275 6         786 my $asn1 = Crypt::Perl::ASN1->new()->prepare($self->ASN1());
276 6         52 $asn1 = $asn1->find('TBSCertificate');
277 6         179 $asn1->configure( encode => { time => 'utctime' } );
278              
279 6         261 return $asn1->encode($params_hr);
280             }
281              
282             #sub _get_GeneralizedTime {
283             # my ($epoch) = @_;
284             #
285             # my @smhdmy = (gmtime $epoch)[0 .. 5];
286             # $smhdmy[4]++; #month
287             # $smhdmy[5] += 1900; #year
288             #
289             # return sprintf '%04d%02d%02d%02d%02d%02dZ', reverse @smhdmy;
290             #}
291              
292             1;