]> git.proxmox.com Git - pve-common.git/blob - src/PVE/Certificate.pm
bump version to 8.2.1
[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 my $header_re = sub {
95 my ($label) = @_;
96 return qr!-----BEGIN\ $label-----(?:\s|\n)*!;
97 };
98 my $footer_re = sub {
99 my ($label) = @_;
100 return qr!-----END\ $label-----(?:\s|\n)*!;
101 };
102 my $pem_re = sub {
103 my ($label) = @_;
104
105 my $b64_char_re = qr![0-9A-Za-z\+/]!; # see RFC 7468
106 my $header = $header_re->($label);
107 my $footer = $footer_re->($label);
108
109 return qr{
110 $header
111 (?:(?:$b64_char_re)+\s*\n)*
112 (?:$b64_char_re)*(?:=\s*\n=|={0,2})?\s*\n
113 $footer
114 }x;
115 };
116
117 sub strip_leading_text {
118 my ($content) = @_;
119
120 my $header = $header_re->(qr/.*?/);
121 $content =~ s/^.*?(?=$header)//s;
122 return $content;
123 };
124
125 sub split_pem {
126 my ($content, %opts) = @_;
127 my $label = $opts{label} // 'CERTIFICATE';
128
129 my $header = $header_re->($label);
130 return split(/(?=$header)/,$content);
131 }
132
133 sub check_pem {
134 my ($content, %opts) = @_;
135
136 $content = strip_leading_text($content);
137
138 my $re = $pem_re->($opts{label} // 'CERTIFICATE');
139 $re = qr/($re\n+)*$re/ if $opts{multiple};
140
141 return $content if $content =~ /^$re$/; # OK
142
143 return undef if $opts{noerr};
144 die "not a valid PEM-formatted string.\n";
145 }
146
147 sub pem_to_der {
148 my ($content) = @_;
149
150 my $header = $header_re->(qr/.*?/);
151 my $footer = $footer_re->(qr/.*?/);
152
153 $content = strip_leading_text($content);
154
155 # only take first PEM entry
156 $content =~ s/^$header$//mg;
157 $content =~ s/$footer.*//sg;
158
159 $content = decode_base64($content);
160
161 return $content;
162 }
163
164 sub der_to_pem {
165 my ($content, %opts) = @_;
166
167 my $label = $opts{label} // 'CERTIFICATE';
168
169 my $b64 = encode_base64($content, '');
170 $b64 = join("\n", ($b64 =~ /.{1,64}/sg));
171 return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
172 }
173
174 my sub ssl_die {
175 my ($msg) = @_;
176 warn Net::SSLeay::print_errs();
177 Net::SSLeay::die_now("$msg\n");
178 };
179
180 my $read_certificate = sub {
181 my ($cert_path) = @_;
182
183 die "'$cert_path' does not exist!\n" if ! -e $cert_path;
184
185 my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
186 or ssl_die("unable to read '$cert_path' - $!");
187
188 my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
189 Net::SSLeay::BIO_free($bio);
190 die "unable to read certificate from '$cert_path'\n" if !$cert;
191
192 return $cert;
193 };
194
195 sub convert_asn1_to_epoch {
196 my ($asn1_time) = @_;
197
198 ssl_die("invalid ASN1 time object") if !$asn1_time;
199 my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
200 ssl_die("unable to parse ASN1 time") if $iso_time eq '';
201 return Date::Parse::str2time($iso_time);
202 }
203
204 sub get_certificate_fingerprint {
205 my ($cert_path) = @_;
206
207 my $cert = $read_certificate->($cert_path);
208
209 my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
210 Net::SSLeay::X509_free($cert);
211
212 die "unable to get fingerprint for '$cert_path' - got empty value\n"
213 if !defined($fp) || $fp eq '';
214
215 return $fp;
216 }
217
218 sub assert_certificate_matches_key {
219 my ($cert_path, $key_path) = @_;
220
221 die "No certificate path given!\n" if !$cert_path;
222 die "No certificate key path given!\n" if !$key_path;
223
224 die "Certificate at '$cert_path' does not exist!\n" if ! -e $cert_path;
225 die "Certificate key '$key_path' does not exist!\n" if ! -e $key_path;
226
227 my $ctx = Net::SSLeay::CTX_new()
228 or ssl_die("Failed to create SSL context in order to verify private key");
229
230 eval {
231 my $filetype = &Net::SSLeay::FILETYPE_PEM;
232
233 Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype)
234 or ssl_die("Failed to load private key from '$key_path' into SSL context");
235
236 Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype)
237 or ssl_die("Failed to load certificate from '$cert_path' into SSL context");
238
239 Net::SSLeay::CTX_check_private_key($ctx)
240 or ssl_die("Failed to validate private key and certificate");
241 };
242 my $err = $@;
243
244 Net::SSLeay::CTX_free($ctx);
245
246 die $err if $err;
247
248 return 1;
249 }
250
251 sub get_certificate_info {
252 my ($cert_path) = @_;
253
254 my $cert = $read_certificate->($cert_path);
255
256 my $parse_san = sub {
257 my $res = [];
258 while (my ($type, $value) = splice(@_, 0, 2)) {
259 if ($type != 2 && $type != 7) {
260 warn "unexpected SAN type encountered: $type\n";
261 next;
262 }
263
264 if ($type == 7) {
265 my $hex = unpack("H*", $value);
266 if (length($hex) == 8) {
267 # IPv4
268 $value = join(".", unpack("C4C4C4C4", $value));
269 } elsif (length($hex) == 32) {
270 # IPv6
271 $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
272 } else {
273 warn "cannot parse SAN IP entry '0x${hex}'\n";
274 next;
275 }
276 }
277
278 push @$res, $value;
279 }
280 return $res;
281 };
282
283 my $info = {};
284
285 $info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
286
287 if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) {
288 $info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
289 }
290
291 if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) {
292 $info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
293 }
294
295 eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) };
296 warn $@ if $@;
297 eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
298 warn $@ if $@;
299
300 $info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert));
301 $info->{pem} = Net::SSLeay::PEM_get_string_X509($cert);
302
303 my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) };
304 warn $@ if $@;
305 if ($pub_key) {
306 $info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key));
307 $info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key);
308 Net::SSLeay::EVP_PKEY_free($pub_key);
309 }
310
311 Net::SSLeay::X509_free($cert);
312
313 $cert_path =~ s!^.*/!!g;
314 $info->{filename} = $cert_path;
315
316 return $info;
317 };
318
319 # Checks whether certificate expires before $timestamp (UNIX epoch)
320 sub check_expiry {
321 my ($cert_path, $timestamp) = @_;
322
323 $timestamp //= time();
324
325 my $cert = $read_certificate->($cert_path);
326 my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
327 my $err = $@;
328
329 Net::SSLeay::X509_free($cert);
330
331 die $err if $err;
332
333 return ($not_after < $timestamp) ? 1 : 0;
334 };
335
336 # Create a CSR and certificate key for a given order
337 # returns path to CSR file or path to CSR and key files
338 sub generate_csr {
339 my (%attr) = @_;
340
341 # optional
342 my $bits = delete($attr{bits}) // 4096;
343 my $dig_alg = delete($attr{digest}) // 'sha256';
344 my $pem_key = delete($attr{private_key});
345
346 # required
347 my $identifiers = delete($attr{identifiers});
348
349 die "Identifiers are required to generate a CSR.\n"
350 if !defined($identifiers);
351
352 my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ];
353 die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
354
355 # optional
356 my $common_name = delete($attr{common_name}) // $san->[0];
357
358 my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) };
359 die "Invalid digest algorithm '$dig_alg'\n" if !$md;
360
361 my ($bio, $pk, $req);
362
363 my $cleanup = sub {
364 my ($die_msg, $no_warn) = @_;
365 Net::SSLeay::print_errs() if !$no_warn;
366
367 Net::SSLeay::X509_REQ_free($req) if $req;
368 Net::SSLeay::EVP_PKEY_free($pk) if $pk;
369 Net::SSLeay::BIO_free($bio) if $bio;
370
371 die $die_msg if $die_msg;
372 };
373
374 # this unfortunately causes a small memory leak, since there is no
375 # X509_NAME_free() (yet)
376 my $name = Net::SSLeay::X509_NAME_new();
377 ssl_die("Failed to allocate X509_NAME object") if !$name;
378 my $add_name_entry = sub {
379 my ($k, $v) = @_;
380
381 my $res = Net::SSLeay::X509_NAME_add_entry_by_txt(
382 $name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v));
383
384 $cleanup->("Failed to add '$k'='$v' to DN\n") if !$res;
385 };
386
387 $add_name_entry->('CN', $common_name);
388 for (qw(C ST L O OU)) {
389 if (defined(my $v = $attr{$_})) {
390 $add_name_entry->($_, $v);
391 }
392 }
393
394 if (defined($pem_key)) {
395 my $bio_s_mem = Net::SSLeay::BIO_s_mem();
396 $cleanup->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem;
397
398 $bio = Net::SSLeay::BIO_new($bio_s_mem);
399 $cleanup->("Failed to allocate BIO for private key\n") if !$bio;
400
401 $cleanup->("Failed to write PEM-encoded key to BIO\n")
402 if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
403
404 $pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
405 $cleanup->("Failed to read private key into EVP_PKEY\n") if !$pk;
406 } else {
407 $pk = Net::SSLeay::EVP_PKEY_new();
408 $cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk;
409
410 my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
411 $cleanup->("Failed to generate RSA key pair\n") if !$rsa;
412
413 $cleanup->("Failed to assign RSA key to EVP_PKEY\n")
414 if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
415 }
416
417 $req = Net::SSLeay::X509_REQ_new();
418 $cleanup->("Failed to allocate X509_REQ\n") if !$req;
419
420 $cleanup->("Failed to set subject name\n")
421 if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
422
423 Net::SSLeay::P_X509_REQ_add_extensions(
424 $req,
425 &Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
426 &Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
427 &Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
428 &Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san),
429 ) or $cleanup->("Failed to add extensions to CSR\n");
430
431 $cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
432
433 $cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 0);
434
435 $cleanup->("Failed to sign CSR\n") if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
436
437 my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk);
438 my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req);
439
440 $cleanup->(undef, 1);
441
442 return wantarray ? ($req_pem, $pk_pem) : $req_pem;
443 }
444
445 1;