File Coverage

lib/Crypt/Perl/X509v3.pm
Criterion Covered Total %
statement 82 89 92.1
branch 19 26 73.0
condition 7 11 63.6
subroutine 14 14 100.0
pod 0 3 0.0
total 122 143 85.3


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