cert: add public key type & size to JSON schema
[pve-common.git] / src / PVE / Certificate.pm
1 package PVE::Certificate;
2
3 use strict;
4 use warnings;
5
6 use Date::Parse;
7 use Encode qw(decode encode);
8 use MIME::Base64 qw(decode_base64 encode_base64);
9 use Net::SSLeay;
10
11 use PVE::JSONSchema qw(get_standard_option);
12
13 Net::SSLeay::load_error_strings();
14 Net::SSLeay::randomize();
15
16 PVE::JSONSchema::register_format('pem-certificate', sub {
17     my ($content, $noerr) = @_;
18
19     return check_pem($content, noerr => $noerr);
20 });
21
22 PVE::JSONSchema::register_format('pem-certificate-chain', sub {
23     my ($content, $noerr) = @_;
24
25     return check_pem($content, noerr => $noerr, multiple => 1);
26 });
27
28 PVE::JSONSchema::register_format('pem-string', sub {
29     my ($content, $noerr) = @_;
30
31     return check_pem($content, noerr => $noerr, label => qr/.*?/);
32 });
33
34 PVE::JSONSchema::register_standard_option('pve-certificate-info', {
35     type => 'object',
36     properties => {
37         filename => {
38             type => 'string',
39             optional => 1,
40         },
41         fingerprint => get_standard_option('fingerprint-sha256', {
42             optional => 1,
43         }),
44         subject => {
45             type => 'string',
46             description => 'Certificate subject name.',
47             optional => 1,
48         },
49         issuer => {
50             type => 'string',
51             description => 'Certificate issuer name.',
52             optional => 1,
53         },
54         notbefore => {
55             type => 'integer',
56             description => 'Certificate\'s notBefore timestamp (UNIX epoch).',
57             renderer => 'timestamp',
58             optional => 1,
59         },
60         notafter => {
61             type => 'integer',
62             description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
63             renderer => 'timestamp',
64             optional => 1,
65         },
66         san => {
67             type => 'array',
68             description => 'List of Certificate\'s SubjectAlternativeName entries.',
69             optional => 1,
70             renderer => 'yaml',
71             items => {
72                 type => 'string',
73             },
74         },
75         pem => {
76             type => 'string',
77             description => 'Certificate in PEM format',
78             format => 'pem-certificate',
79             optional => 1,
80         },
81         'public-key-type' => {
82             type => 'string',
83             description => 'Certificate\'s public key algorithm',
84             optional => 1,
85         },
86         'public-key-bits' => {
87             type => 'integer',
88             description => 'Certificate\'s public key size',
89             optional => 1,
90         },
91     },
92 });
93
94 # see RFC 7468
95 my $b64_char_re = qr![0-9A-Za-z\+/]!;
96 my $header_re = sub {
97     my ($label) = @_;
98     return qr!-----BEGIN\ $label-----(?:\s|\n)*!;
99 };
100 my $footer_re = sub {
101     my ($label) = @_;
102     return qr!-----END\ $label-----(?:\s|\n)*!;
103 };
104 my $pem_re = sub {
105     my ($label) = @_;
106
107     my $header = $header_re->($label);
108     my $footer = $footer_re->($label);
109
110     return qr{
111         $header
112         (?:(?:$b64_char_re)+\s*\n)*
113         (?:$b64_char_re)*(?:=\s*\n=|={0,2})?\s*\n
114         $footer
115     }x;
116 };
117
118 sub strip_leading_text {
119     my ($content) = @_;
120
121     my $header = $header_re->(qr/.*?/);
122     $content =~ s/^.*?(?=$header)//s;
123     return $content;
124 };
125
126 sub split_pem {
127     my ($content, %opts) = @_;
128     my $label = $opts{label} // 'CERTIFICATE';
129
130     my $header = $header_re->($label);
131     return split(/(?=$header)/,$content);
132 }
133
134 sub check_pem {
135     my ($content, %opts) = @_;
136
137     my $label = $opts{label} // 'CERTIFICATE';
138     my $multiple = $opts{multiple};
139     my $noerr = $opts{noerr};
140
141     $content = strip_leading_text($content);
142
143     my $re = $pem_re->($label);
144
145     $re = qr/($re\n+)*$re/ if $multiple;
146
147     if ($content =~ /^$re$/) {
148         return $content;
149     } else {
150         return undef if $noerr;
151         die "not a valid PEM-formatted string.\n";
152     }
153 }
154
155 sub pem_to_der {
156     my ($content) = @_;
157
158     my $header = $header_re->(qr/.*?/);
159     my $footer = $footer_re->(qr/.*?/);
160
161     $content = strip_leading_text($content);
162
163     # only take first PEM entry
164     $content =~ s/^$header$//mg;
165     $content =~ s/$footer.*//sg;
166
167     $content = decode_base64($content);
168
169     return $content;
170 }
171
172 sub der_to_pem {
173     my ($content, %opts) = @_;
174
175     my $label = $opts{label} // 'CERTIFICATE';
176
177     my $b64 = encode_base64($content, '');
178     $b64 = join("\n", ($b64 =~ /.{1,64}/sg));
179     return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
180 }
181
182 my $ssl_die = sub {
183     my ($msg) = @_;
184     Net::SSLeay::die_now($msg);
185 };
186
187 my $ssl_warn = sub {
188     my ($msg) = @_;
189     Net::SSLeay::print_errs();
190     warn $msg if $msg;
191 };
192
193 my $read_certificate = sub {
194     my ($cert_path) = @_;
195
196     die "'$cert_path' does not exist!\n" if ! -e $cert_path;
197
198     my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
199         or $ssl_die->("unable to read '$cert_path' - $!\n");
200
201     my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
202     if (!$cert) {
203         Net::SSLeay::BIO_free($bio);
204         die "unable to read certificate from '$cert_path'\n";
205     }
206
207     return $cert;
208 };
209
210 sub convert_asn1_to_epoch {
211     my ($asn1_time) = @_;
212
213     $ssl_die->("invalid ASN1 time object\n") if !$asn1_time;
214     my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
215     $ssl_die->("unable to parse ASN1 time\n") if $iso_time eq '';
216     return Date::Parse::str2time($iso_time);
217 }
218
219 sub get_certificate_info {
220     my ($cert_path) = @_;
221
222     my $cert = $read_certificate->($cert_path);
223
224     my $parse_san = sub {
225         my $res = [];
226         while (my ($type, $value) = splice(@_, 0, 2)) {
227             if ($type != 2 && $type != 7) {
228                 warn "unexpected SAN type encountered: $type\n";
229                 next;
230             }
231
232             if ($type == 7) {
233                 my $hex = unpack("H*", $value);
234                 if (length($hex) == 8) {
235                     # IPv4
236                     $value = join(".", unpack("C4C4C4C4", $value));
237                 } elsif (length($hex) == 32) {
238                     # IPv6
239                     $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
240                 } else {
241                     warn "cannot parse SAN IP entry '0x${hex}'\n";
242                     next;
243                 }
244             }
245
246             push @$res, $value;
247         }
248         return $res;
249     };
250
251     my $info = {};
252
253     $info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
254
255     my $subject = Net::SSLeay::X509_get_subject_name($cert);
256     if ($subject) {
257         $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
258     }
259
260     my $issuer = Net::SSLeay::X509_get_issuer_name($cert);
261     if ($issuer) {
262         $info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
263     }
264
265     eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) };
266     warn $@ if $@;
267     eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
268     warn $@ if $@;
269
270     $info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert));
271     $info->{pem} = Net::SSLeay::PEM_get_string_X509($cert);
272
273     my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) };
274     warn $@ if $@;
275     if ($pub_key) {
276         $info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key));
277         $info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key);
278         Net::SSLeay::EVP_PKEY_free($pub_key);
279     }
280
281     Net::SSLeay::X509_free($cert);
282
283     $cert_path =~ s!^.*/!!g;
284     $info->{filename} = $cert_path;
285
286     return $info;
287 };
288
289 # Checks whether certificate expires before $timestamp (UNIX epoch)
290 sub check_expiry {
291     my ($cert_path, $timestamp) = @_;
292
293     $timestamp //= time();
294
295     my $cert = $read_certificate->($cert_path);
296     my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
297     my $err = $@;
298
299     Net::SSLeay::X509_free($cert);
300
301     die $err if $err;
302
303     return ($not_after < $timestamp) ? 1 : 0;
304 };
305
306 # Create a CSR and certificate key for a given order
307 # returns path to CSR file or path to CSR and key files
308 sub generate_csr {
309     my (%attr) = @_;
310
311     # optional
312     my $bits = delete($attr{bits}) // 4096;
313     my $dig_alg = delete($attr{digest}) // 'sha256';
314     my $pem_key = delete($attr{private_key});
315
316     # required
317     my $identifiers = delete($attr{identifiers});
318
319     die "Identifiers are required to generate a CSR.\n"
320         if !defined($identifiers);
321
322     my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ];
323     die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
324
325     my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) };
326     die "Invalid digest algorithm '$dig_alg'\n" if !$md;
327
328     my ($bio, $pk, $req);
329
330     my $cleanup = sub {
331         my ($warn, $die_msg) = @_;
332         $ssl_warn->() if $warn;
333
334         Net::SSLeay::X509_REQ_free($req) if  $req;
335         Net::SSLeay::EVP_PKEY_free($pk) if $pk;
336         Net::SSLeay::BIO_free($bio) if $bio;
337
338         die $die_msg if $die_msg;
339     };
340
341     # this unfortunately causes a small memory leak, since there is no
342     # X509_NAME_free() (yet)
343     my $name = Net::SSLeay::X509_NAME_new();
344     $ssl_die->("Failed to allocate X509_NAME object\n") if !$name;
345     my $add_name_entry = sub {
346         my ($k, $v) = @_;
347         if (!Net::SSLeay::X509_NAME_add_entry_by_txt($name,
348                                                      $k,
349                                                      &Net::SSLeay::MBSTRING_UTF8,
350                                                      encode('utf-8', $v))) {
351             $cleanup->(1, "Failed to add '$k'='$v' to DN\n");
352         }
353     };
354
355     $add_name_entry->('CN', @$san[0]);
356     for (qw(C ST L O OU)) {
357         if (defined(my $v = $attr{$_})) {
358             $add_name_entry->($_, $v);
359         }
360     }
361
362     if (defined($pem_key)) {
363         my $bio_s_mem = Net::SSLeay::BIO_s_mem();
364         $cleanup->(1, "Failed to allocate BIO_s_mem for private key\n")
365             if !$bio_s_mem;
366
367         $bio = Net::SSLeay::BIO_new($bio_s_mem);
368         $cleanup->(1, "Failed to allocate BIO for private key\n") if !$bio;
369
370         $cleanup->(1, "Failed to write PEM-encoded key to BIO\n")
371             if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
372
373         $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
374         $cleanup->(1, "Failed to read private key into EVP_PKEY\n") if !$pk;
375     } else {
376         $pk = Net::SSLeay::EVP_PKEY_new();
377         $cleanup->(1, "Failed to allocate EVP_PKEY for private key\n") if !$pk;
378
379         my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
380         $cleanup->(1, "Failed to generate RSA key pair\n") if !$rsa;
381
382         $cleanup->(1, "Failed to assign RSA key to EVP_PKEY\n")
383             if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
384     }
385
386     $req = Net::SSLeay::X509_REQ_new();
387     $cleanup->(1, "Failed to allocate X509_REQ\n") if !$req;
388
389     $cleanup->(1, "Failed to set subject name\n")
390         if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
391
392     $cleanup->(1, "Failed to add extensions to CSR\n")
393         if !Net::SSLeay::P_X509_REQ_add_extensions($req,
394                 &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
395                 &Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
396                 &Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
397                 &Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san),
398         );
399
400     $cleanup->(1, "Failed to set public key\n")
401         if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
402
403     $cleanup->(1, "Failed to set CSR version\n")
404         if !Net::SSLeay::X509_REQ_set_version($req, 2);
405
406     $cleanup->(1, "Failed to sign CSR\n")
407         if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
408
409     my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk);
410     my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req);
411
412     $cleanup->();
413
414     return wantarray ? ($req_pem, $pk_pem) : $req_pem;
415 }
416
417 1;