1 package PVE
::Certificate
;
7 use Encode
qw(decode encode);
8 use MIME
::Base64
qw(decode_base64 encode_base64);
11 use PVE
::JSONSchema
qw(get_standard_option);
13 Net
::SSLeay
::load_error_strings
();
14 Net
::SSLeay
::randomize
();
16 PVE
::JSONSchema
::register_format
('pem-certificate', sub {
17 my ($content, $noerr) = @_;
19 return check_pem
($content, noerr
=> $noerr);
22 PVE
::JSONSchema
::register_format
('pem-certificate-chain', sub {
23 my ($content, $noerr) = @_;
25 return check_pem
($content, noerr
=> $noerr, multiple
=> 1);
28 PVE
::JSONSchema
::register_format
('pem-string', sub {
29 my ($content, $noerr) = @_;
31 return check_pem
($content, noerr
=> $noerr, label
=> qr/.*?/);
34 PVE
::JSONSchema
::register_standard_option
('pve-certificate-info', {
41 fingerprint
=> get_standard_option
('fingerprint-sha256', {
46 description
=> 'Certificate subject name.',
51 description
=> 'Certificate issuer name.',
56 description
=> 'Certificate\'s notBefore timestamp (UNIX epoch).',
57 renderer
=> 'timestamp',
62 description
=> 'Certificate\'s notAfter timestamp (UNIX epoch).',
63 renderer
=> 'timestamp',
68 description
=> 'List of Certificate\'s SubjectAlternativeName entries.',
77 description
=> 'Certificate in PEM format',
78 format
=> 'pem-certificate',
81 'public-key-type' => {
83 description
=> 'Certificate\'s public key algorithm',
86 'public-key-bits' => {
88 description
=> 'Certificate\'s public key size',
95 my $b64_char_re = qr![0-9A-Za-z\+/]!;
98 return qr!-----BEGIN\ $label-----(?:\s|\n)*!;
100 my $footer_re = sub {
102 return qr!-----END\ $label-----(?:\s|\n)*!;
107 my $header = $header_re->($label);
108 my $footer = $footer_re->($label);
112 (?
:(?
:$b64_char_re)+\s
*\n)*
113 (?
:$b64_char_re)*(?
:=\s
*\n=|={0,2})?\s
*\n
118 sub strip_leading_text
{
121 my $header = $header_re->(qr/.*?/);
122 $content =~ s/^.*?(?=$header)//s;
127 my ($content, %opts) = @_;
128 my $label = $opts{label
} // 'CERTIFICATE';
130 my $header = $header_re->($label);
131 return split(/(?=$header)/,$content);
135 my ($content, %opts) = @_;
137 my $label = $opts{label
} // 'CERTIFICATE';
138 my $multiple = $opts{multiple
};
139 my $noerr = $opts{noerr
};
141 $content = strip_leading_text
($content);
143 my $re = $pem_re->($label);
145 $re = qr/($re\n+)*$re/ if $multiple;
147 if ($content =~ /^$re$/) {
150 return undef if $noerr;
151 die "not a valid PEM-formatted string.\n";
158 my $header = $header_re->(qr/.*?/);
159 my $footer = $footer_re->(qr/.*?/);
161 $content = strip_leading_text
($content);
163 # only take first PEM entry
164 $content =~ s/^$header$//mg;
165 $content =~ s/$footer.*//sg;
167 $content = decode_base64
($content);
173 my ($content, %opts) = @_;
175 my $label = $opts{label
} // 'CERTIFICATE';
177 my $b64 = encode_base64
($content, '');
178 $b64 = join("\n", ($b64 =~ /.{1,64}/sg));
179 return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
184 Net
::SSLeay
::die_now
($msg);
189 Net
::SSLeay
::print_errs
();
193 my $read_certificate = sub {
194 my ($cert_path) = @_;
196 die "'$cert_path' does not exist!\n" if ! -e
$cert_path;
198 my $bio = Net
::SSLeay
::BIO_new_file
($cert_path, 'r')
199 or ssl_die
("unable to read '$cert_path' - $!\n");
201 my $cert = Net
::SSLeay
::PEM_read_bio_X509
($bio);
202 Net
::SSLeay
::BIO_free
($bio);
203 die "unable to read certificate from '$cert_path'\n" if !$cert;
208 sub convert_asn1_to_epoch
{
209 my ($asn1_time) = @_;
211 ssl_die
("invalid ASN1 time object\n") if !$asn1_time;
212 my $iso_time = Net
::SSLeay
::P_ASN1_TIME_get_isotime
($asn1_time);
213 ssl_die
("unable to parse ASN1 time\n") if $iso_time eq '';
214 return Date
::Parse
::str2time
($iso_time);
217 sub get_certificate_fingerprint
{
218 my ($cert_path) = @_;
220 my $cert = $read_certificate->($cert_path);
222 my $fp = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
223 Net
::SSLeay
::X509_free
($cert);
225 die "unable to get fingerprint for '$cert_path' - got empty value\n"
226 if !defined($fp) || $fp eq '';
231 sub check_certificate_matches_key
{
232 my ($cert_path, $key_path) = @_;
234 die "No certificate path given!\n" if !$cert_path;
235 die "No certificate key path given!\n" if !$key_path;
237 die "Certificate at '$cert_path' does not exist!\n" if ! -e
$cert_path;
238 die "Certificate key '$key_path' does not exist!\n" if ! -e
$key_path;
240 my $ctx = Net
::SSLeay
::CTX_new
()
241 or ssl_die
("Failed to create SSL context in order to verify private key");
244 my $filetype = &Net
::SSLeay
::FILETYPE_PEM
;
246 Net
::SSLeay
::CTX_use_PrivateKey_file
($ctx, $key_path, $filetype)
247 or ssl_die
("Failed to load private key from '$key_path' into SSL context");
249 Net
::SSLeay
::CTX_use_certificate_file
($ctx, $cert_path, $filetype)
250 or ssl_die
("Failed to load certificate from '$cert_path' into SSL context");
252 Net
::SSLeay
::CTX_check_private_key
($ctx)
253 or ssl_die
("Failed to validate private key and certificate");
257 Net
::SSLeay
::CTX_free
($ctx);
264 sub get_certificate_info
{
265 my ($cert_path) = @_;
267 my $cert = $read_certificate->($cert_path);
269 my $parse_san = sub {
271 while (my ($type, $value) = splice(@_, 0, 2)) {
272 if ($type != 2 && $type != 7) {
273 warn "unexpected SAN type encountered: $type\n";
278 my $hex = unpack("H*", $value);
279 if (length($hex) == 8) {
281 $value = join(".", unpack("C4C4C4C4", $value));
282 } elsif (length($hex) == 32) {
284 $value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
286 warn "cannot parse SAN IP entry '0x${hex}'\n";
298 $info->{fingerprint
} = Net
::SSLeay
::X509_get_fingerprint
($cert, 'sha256');
300 my $subject = Net
::SSLeay
::X509_get_subject_name
($cert);
302 $info->{subject
} = Net
::SSLeay
::X509_NAME_oneline
($subject);
305 my $issuer = Net
::SSLeay
::X509_get_issuer_name
($cert);
307 $info->{issuer
} = Net
::SSLeay
::X509_NAME_oneline
($issuer);
310 eval { $info->{notbefore
} = convert_asn1_to_epoch
(Net
::SSLeay
::X509_get_notBefore
($cert)) };
312 eval { $info->{notafter
} = convert_asn1_to_epoch
(Net
::SSLeay
::X509_get_notAfter
($cert)) };
315 $info->{san
} = $parse_san->(Net
::SSLeay
::X509_get_subjectAltNames
($cert));
316 $info->{pem
} = Net
::SSLeay
::PEM_get_string_X509
($cert);
318 my $pub_key = eval { Net
::SSLeay
::X509_get_pubkey
($cert) };
321 $info->{'public-key-type'} = Net
::SSLeay
::OBJ_nid2sn
(Net
::SSLeay
::EVP_PKEY_id
($pub_key));
322 $info->{'public-key-bits'} = Net
::SSLeay
::EVP_PKEY_bits
($pub_key);
323 Net
::SSLeay
::EVP_PKEY_free
($pub_key);
326 Net
::SSLeay
::X509_free
($cert);
328 $cert_path =~ s!^.*/!!g;
329 $info->{filename
} = $cert_path;
334 # Checks whether certificate expires before $timestamp (UNIX epoch)
336 my ($cert_path, $timestamp) = @_;
338 $timestamp //= time();
340 my $cert = $read_certificate->($cert_path);
341 my $not_after = eval { convert_asn1_to_epoch
(Net
::SSLeay
::X509_get_notAfter
($cert)) };
344 Net
::SSLeay
::X509_free
($cert);
348 return ($not_after < $timestamp) ?
1 : 0;
351 # Create a CSR and certificate key for a given order
352 # returns path to CSR file or path to CSR and key files
357 my $bits = delete($attr{bits
}) // 4096;
358 my $dig_alg = delete($attr{digest
}) // 'sha256';
359 my $pem_key = delete($attr{private_key
});
362 my $identifiers = delete($attr{identifiers
});
364 die "Identifiers are required to generate a CSR.\n"
365 if !defined($identifiers);
367 my $san = [ map { $_->{value
} } grep { $_->{type
} eq 'dns' } @$identifiers ];
368 die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
371 my $common_name = delete($attr{common_name
}) // $san->[0];
373 my $md = eval { Net
::SSLeay
::EVP_get_digestbyname
($dig_alg) };
374 die "Invalid digest algorithm '$dig_alg'\n" if !$md;
376 my ($bio, $pk, $req);
379 my ($warn, $die_msg) = @_;
380 $ssl_warn->() if $warn;
382 Net
::SSLeay
::X509_REQ_free
($req) if $req;
383 Net
::SSLeay
::EVP_PKEY_free
($pk) if $pk;
384 Net
::SSLeay
::BIO_free
($bio) if $bio;
386 die $die_msg if $die_msg;
389 # this unfortunately causes a small memory leak, since there is no
390 # X509_NAME_free() (yet)
391 my $name = Net
::SSLeay
::X509_NAME_new
();
392 ssl_die
("Failed to allocate X509_NAME object\n") if !$name;
393 my $add_name_entry = sub {
396 my $res = Net
::SSLeay
::X509_NAME_add_entry_by_txt
(
399 &Net
::SSLeay
::MBSTRING_UTF8
,
403 $cleanup->(1, "Failed to add '$k'='$v' to DN\n") if !$res;
406 $add_name_entry->('CN', $common_name);
407 for (qw(C ST L O OU)) {
408 if (defined(my $v = $attr{$_})) {
409 $add_name_entry->($_, $v);
413 if (defined($pem_key)) {
414 my $bio_s_mem = Net
::SSLeay
::BIO_s_mem
();
415 $cleanup->(1, "Failed to allocate BIO_s_mem for private key\n")
418 $bio = Net
::SSLeay
::BIO_new
($bio_s_mem);
419 $cleanup->(1, "Failed to allocate BIO for private key\n") if !$bio;
421 $cleanup->(1, "Failed to write PEM-encoded key to BIO\n")
422 if Net
::SSLeay
::BIO_write
($bio, $pem_key) <= 0;
424 $pk = Net
::SSLeay
::PEM_read_bio_PrivateKey
($bio);
425 $cleanup->(1, "Failed to read private key into EVP_PKEY\n") if !$pk;
427 $pk = Net
::SSLeay
::EVP_PKEY_new
();
428 $cleanup->(1, "Failed to allocate EVP_PKEY for private key\n") if !$pk;
430 my $rsa = Net
::SSLeay
::RSA_generate_key
($bits, 65537);
431 $cleanup->(1, "Failed to generate RSA key pair\n") if !$rsa;
433 $cleanup->(1, "Failed to assign RSA key to EVP_PKEY\n")
434 if !Net
::SSLeay
::EVP_PKEY_assign_RSA
($pk, $rsa);
437 $req = Net
::SSLeay
::X509_REQ_new
();
438 $cleanup->(1, "Failed to allocate X509_REQ\n") if !$req;
440 $cleanup->(1, "Failed to set subject name\n")
441 if (!Net
::SSLeay
::X509_REQ_set_subject_name
($req, $name));
443 Net
::SSLeay
::P_X509_REQ_add_extensions
(
445 &Net
::SSLeay
::NID_key_usage
=> 'digitalSignature,keyEncipherment',
446 &Net
::SSLeay
::NID_basic_constraints
=> 'CA:FALSE',
447 &Net
::SSLeay
::NID_ext_key_usage
=> 'serverAuth,clientAuth',
448 &Net
::SSLeay
::NID_subject_alt_name
=> join(',', map { "DNS:$_" } @$san),
449 ) or $cleanup->(1, "Failed to add extensions to CSR\n");
451 $cleanup->(1, "Failed to set public key\n")
452 if !Net
::SSLeay
::X509_REQ_set_pubkey
($req, $pk);
454 $cleanup->(1, "Failed to set CSR version\n")
455 if !Net
::SSLeay
::X509_REQ_set_version
($req, 2);
457 $cleanup->(1, "Failed to sign CSR\n")
458 if !Net
::SSLeay
::X509_REQ_sign
($req, $pk, $md);
460 my $pk_pem = Net
::SSLeay
::PEM_get_string_PrivateKey
($pk);
461 my $req_pem = Net
::SSLeay
::PEM_get_string_X509_REQ
($req);
465 return wantarray ?
($req_pem, $pk_pem) : $req_pem;