mirror of
git://git.proxmox.com/git/pve-common.git
synced 2025-02-25 21:57:42 +03:00
add Certificate helper
general purpose certificate related helper functions Signed-off-by: Fabian Grünbichler <f.gruenbichler@proxmox.com>
This commit is contained in:
Fabian Grünbichler
Thomas Lamprecht
parent
62635f9235
commit
4e0952c9e8
@ -8,6 +8,7 @@ PERLDIR=${PREFIX}/share/perl5
|
||||
|
||||
LIB_SOURCES = \
|
||||
AtomicFile.pm \
|
||||
Certificate.pm \
|
||||
CLIHandler.pm \
|
||||
CalendarEvent.pm \
|
||||
CpuSet.pm \
|
||||
|
||||
396
src/PVE/Certificate.pm
Normal file
396
src/PVE/Certificate.pm
Normal file
@ -0,0 +1,396 @@
|
||||
package PVE::Certificate;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Date::Parse;
|
||||
use Encode qw(decode encode);
|
||||
use MIME::Base64 qw(decode_base64 encode_base64);
|
||||
use Net::SSLeay;
|
||||
|
||||
use PVE::JSONSchema qw(get_standard_option);
|
||||
|
||||
Net::SSLeay::load_error_strings();
|
||||
Net::SSLeay::randomize();
|
||||
|
||||
PVE::JSONSchema::register_format('pem-certificate', sub {
|
||||
my ($content, $noerr) = @_;
|
||||
|
||||
return check_pem($content, noerr => $noerr);
|
||||
});
|
||||
|
||||
PVE::JSONSchema::register_format('pem-certificate-chain', sub {
|
||||
my ($content, $noerr) = @_;
|
||||
|
||||
return check_pem($content, noerr => $noerr, multiple => 1);
|
||||
});
|
||||
|
||||
PVE::JSONSchema::register_format('pem-string', sub {
|
||||
my ($content, $noerr) = @_;
|
||||
|
||||
return check_pem($content, noerr => $noerr, label => qr/.*?/);
|
||||
});
|
||||
|
||||
PVE::JSONSchema::register_standard_option('pve-certificate-info', {
|
||||
type => 'object',
|
||||
properties => {
|
||||
filename => {
|
||||
type => 'string',
|
||||
optional => 1,
|
||||
},
|
||||
fingerprint => get_standard_option('fingerprint-sha256', {
|
||||
optional => 1,
|
||||
}),
|
||||
subject => {
|
||||
type => 'string',
|
||||
description => 'Certificate subject name.',
|
||||
optional => 1,
|
||||
},
|
||||
issuer => {
|
||||
type => 'string',
|
||||
description => 'Certificate issuer name.',
|
||||
optional => 1,
|
||||
},
|
||||
notbefore => {
|
||||
type => 'integer',
|
||||
description => 'Certificate\'s notBefore timestamp (UNIX epoch).',
|
||||
optional => 1,
|
||||
},
|
||||
notafter => {
|
||||
type => 'integer',
|
||||
description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
|
||||
optional => 1,
|
||||
},
|
||||
san => {
|
||||
type => 'array',
|
||||
description => 'List of Certificate\'s SubjectAlternativeName entries.',
|
||||
optional => 1,
|
||||
items => {
|
||||
type => 'string',
|
||||
},
|
||||
},
|
||||
pem => {
|
||||
type => 'string',
|
||||
description => 'Certificate in PEM format',
|
||||
format => 'pem-certificate',
|
||||
optional => 1,
|
||||
},
|
||||
},
|
||||
});
|
||||
|
||||
# see RFC 7468
|
||||
my $b64_char_re = qr![0-9A-Za-z\+/]!;
|
||||
my $header_re = sub {
|
||||
my ($label) = @_;
|
||||
return qr!-----BEGIN\ $label-----(?:\s|\n)*!;
|
||||
};
|
||||
my $footer_re = sub {
|
||||
my ($label) = @_;
|
||||
return qr!-----END\ $label-----(?:\s|\n)*!;
|
||||
};
|
||||
my $pem_re = sub {
|
||||
my ($label) = @_;
|
||||
|
||||
my $header = $header_re->($label);
|
||||
my $footer = $footer_re->($label);
|
||||
|
||||
return qr{
|
||||
$header
|
||||
(?:(?:$b64_char_re)+\s*\n)*
|
||||
(?:$b64_char_re)*(?:=\s*\n=|={0,2})?\s*\n
|
||||
$footer
|
||||
}x;
|
||||
};
|
||||
|
||||
sub strip_leading_text {
|
||||
my ($content) = @_;
|
||||
|
||||
my $header = $header_re->(qr/.*?/);
|
||||
$content =~ s/^.*?(?=$header)//s;
|
||||
return $content;
|
||||
};
|
||||
|
||||
sub split_pem {
|
||||
my ($content, %opts) = @_;
|
||||
my $label = $opts{label} // 'CERTIFICATE';
|
||||
|
||||
my $header = $header_re->($label);
|
||||
return split(/(?=$header)/,$content);
|
||||
}
|
||||
|
||||
sub check_pem {
|
||||
my ($content, %opts) = @_;
|
||||
|
||||
my $label = $opts{label} // 'CERTIFICATE';
|
||||
my $multiple = $opts{multiple};
|
||||
my $noerr = $opts{noerr};
|
||||
|
||||
$content = strip_leading_text($content);
|
||||
|
||||
my $re = $pem_re->($label);
|
||||
|
||||
$re = qr/($re\n+)*$re/ if $multiple;
|
||||
|
||||
if ($content =~ /^$re$/) {
|
||||
return $content;
|
||||
} else {
|
||||
return undef if $noerr;
|
||||
die "not a valid PEM-formatted string.\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub pem_to_der {
|
||||
my ($content) = @_;
|
||||
|
||||
my $header = $header_re->(qr/.*?/);
|
||||
my $footer = $footer_re->(qr/.*?/);
|
||||
|
||||
$content = strip_leading_text($content);
|
||||
|
||||
# only take first PEM entry
|
||||
$content =~ s/^$header$//mg;
|
||||
$content =~ s/$footer.*//sg;
|
||||
|
||||
$content = decode_base64($content);
|
||||
|
||||
return $content;
|
||||
}
|
||||
|
||||
sub der_to_pem {
|
||||
my ($content, %opts) = @_;
|
||||
|
||||
my $label = $opts{label} // 'CERTIFICATE';
|
||||
|
||||
my $b64 = encode_base64($content, '');
|
||||
$b64 = join("\n", ($b64 =~ /.{1,64}/sg));
|
||||
return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
|
||||
}
|
||||
|
||||
my $ssl_die = sub {
|
||||
my ($msg) = @_;
|
||||
Net::SSLeay::die_now($msg);
|
||||
};
|
||||
|
||||
my $ssl_warn = sub {
|
||||
my ($msg) = @_;
|
||||
Net::SSLeay::print_errs();
|
||||
warn $msg if $msg;
|
||||
};
|
||||
|
||||
my $read_certificate = sub {
|
||||
my ($cert_path) = @_;
|
||||
|
||||
die "'$cert_path' does not exist!\n" if ! -e $cert_path;
|
||||
|
||||
my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
|
||||
or $ssl_die->("unable to read '$cert_path' - $!\n");
|
||||
|
||||
my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
|
||||
if (!$cert) {
|
||||
Net::SSLeay::BIO_free($bio);
|
||||
die "unable to read certificate from '$cert_path'\n";
|
||||
}
|
||||
|
||||
return $cert;
|
||||
};
|
||||
|
||||
sub convert_asn1_to_epoch {
|
||||
my ($asn1_time) = @_;
|
||||
|
||||
$ssl_die->("invalid ASN1 time object\n") if !$asn1_time;
|
||||
my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
|
||||
$ssl_die->("unable to parse ASN1 time\n") if $iso_time eq '';
|
||||
return Date::Parse::str2time($iso_time);
|
||||
}
|
||||
|
||||
sub get_certificate_info {
|
||||
my ($cert_path) = @_;
|
||||
|
||||
my $cert = $read_certificate->($cert_path);
|
||||
|
||||
my $parse_san = sub {
|
||||
my $res = [];
|
||||
while (my ($type, $value) = splice(@_, 0, 2)) {
|
||||
if ($type != 2 && $type != 7) {
|
||||
warn "unexpected SAN type encountered: $type\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if ($type == 7) {
|
||||
my $hex = unpack("H*", $value);
|
||||
if (length($hex) == 8) {
|
||||
# IPv4
|
||||
$value = join(".", unpack("C4C4C4C4", $value));
|
||||
} elsif (length($hex) == 32) {
|
||||
# IPv6
|
||||
$value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
|
||||
} else {
|
||||
warn "cannot parse SAN IP entry '0x${hex}'\n";
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
push @$res, $value;
|
||||
}
|
||||
return $res;
|
||||
};
|
||||
|
||||
my $info = {};
|
||||
|
||||
$info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
|
||||
|
||||
my $subject = Net::SSLeay::X509_get_subject_name($cert);
|
||||
if ($subject) {
|
||||
$info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
|
||||
}
|
||||
|
||||
my $issuer = Net::SSLeay::X509_get_issuer_name($cert);
|
||||
if ($issuer) {
|
||||
$info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
|
||||
}
|
||||
|
||||
eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) };
|
||||
warn $@ if $@;
|
||||
eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
|
||||
warn $@ if $@;
|
||||
|
||||
$info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert));
|
||||
$info->{pem} = Net::SSLeay::PEM_get_string_X509($cert);
|
||||
|
||||
Net::SSLeay::X509_free($cert);
|
||||
|
||||
$cert_path =~ s!^.*/!!g;
|
||||
$info->{filename} = $cert_path;
|
||||
|
||||
return $info;
|
||||
};
|
||||
|
||||
# Checks whether certificate expires before $timestamp (UNIX epoch)
|
||||
sub check_expiry {
|
||||
my ($cert_path, $timestamp) = @_;
|
||||
|
||||
$timestamp //= time();
|
||||
|
||||
my $cert = $read_certificate->($cert_path);
|
||||
my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
|
||||
my $err = $@;
|
||||
|
||||
Net::SSLeay::X509_free($cert);
|
||||
|
||||
die $err if $err;
|
||||
|
||||
return ($not_after < $timestamp) ? 1 : 0;
|
||||
};
|
||||
|
||||
# Create a CSR and certificate key for a given order
|
||||
# returns path to CSR file or path to CSR and key files
|
||||
sub generate_csr {
|
||||
my (%attr) = @_;
|
||||
|
||||
# optional
|
||||
my $bits = delete($attr{bits}) // 4096;
|
||||
my $dig_alg = delete($attr{digest}) // 'sha256';
|
||||
my $pem_key = delete($attr{private_key});
|
||||
|
||||
# required
|
||||
my $identifiers = delete($attr{identifiers});
|
||||
|
||||
die "Identifiers are required to generate a CSR.\n"
|
||||
if !defined($identifiers);
|
||||
|
||||
my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ];
|
||||
die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
|
||||
|
||||
my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) };
|
||||
die "Invalid digest algorithm '$dig_alg'\n" if !$md;
|
||||
|
||||
my ($bio, $pk, $req);
|
||||
|
||||
my $cleanup = sub {
|
||||
my ($warn, $die_msg) = @_;
|
||||
$ssl_warn->() if $warn;
|
||||
|
||||
Net::SSLeay::X509_REQ_free($req) if $req;
|
||||
Net::SSLeay::EVP_PKEY_free($pk) if $pk;
|
||||
Net::SSLeay::BIO_free($bio) if $bio;
|
||||
|
||||
die $die_msg if $die_msg;
|
||||
};
|
||||
|
||||
# this unfortunately causes a small memory leak, since there is no
|
||||
# X509_NAME_free() (yet)
|
||||
my $name = Net::SSLeay::X509_NAME_new();
|
||||
$ssl_die->("Failed to allocate X509_NAME object\n") if !$name;
|
||||
my $add_name_entry = sub {
|
||||
my ($k, $v) = @_;
|
||||
if (!Net::SSLeay::X509_NAME_add_entry_by_txt($name,
|
||||
$k,
|
||||
&Net::SSLeay::MBSTRING_UTF8,
|
||||
encode('utf-8', $v))) {
|
||||
$cleanup->(1, "Failed to add '$k'='$v' to DN\n");
|
||||
}
|
||||
};
|
||||
|
||||
$add_name_entry->('CN', @$san[0]);
|
||||
for (qw(C ST L O OU)) {
|
||||
if (defined(my $v = $attr{$_})) {
|
||||
$add_name_entry->($_, $v);
|
||||
}
|
||||
}
|
||||
|
||||
if (defined($pem_key)) {
|
||||
my $bio_s_mem = Net::SSLeay::BIO_s_mem();
|
||||
$cleanup->(1, "Failed to allocate BIO_s_mem for private key\n")
|
||||
if !$bio_s_mem;
|
||||
|
||||
$bio = Net::SSLeay::BIO_new($bio_s_mem);
|
||||
$cleanup->(1, "Failed to allocate BIO for private key\n") if !$bio;
|
||||
|
||||
$cleanup->(1, "Failed to write PEM-encoded key to BIO\n")
|
||||
if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
|
||||
|
||||
$pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
|
||||
$cleanup->(1, "Failed to read private key into EVP_PKEY\n") if !$pk;
|
||||
} else {
|
||||
$pk = Net::SSLeay::EVP_PKEY_new();
|
||||
$cleanup->(1, "Failed to allocate EVP_PKEY for private key\n") if !$pk;
|
||||
|
||||
my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
|
||||
$cleanup->(1, "Failed to generate RSA key pair\n") if !$rsa;
|
||||
|
||||
$cleanup->(1, "Failed to assign RSA key to EVP_PKEY\n")
|
||||
if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
|
||||
}
|
||||
|
||||
$req = Net::SSLeay::X509_REQ_new();
|
||||
$cleanup->(1, "Failed to allocate X509_REQ\n") if !$req;
|
||||
|
||||
$cleanup->(1, "Failed to set subject name\n")
|
||||
if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
|
||||
|
||||
$cleanup->(1, "Failed to add extensions to CSR\n")
|
||||
if !Net::SSLeay::P_X509_REQ_add_extensions($req,
|
||||
&Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
|
||||
&Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
|
||||
&Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
|
||||
&Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san),
|
||||
);
|
||||
|
||||
$cleanup->(1, "Failed to set public key\n")
|
||||
if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
|
||||
|
||||
$cleanup->(1, "Failed to set CSR version\n")
|
||||
if !Net::SSLeay::X509_REQ_set_version($req, 2);
|
||||
|
||||
$cleanup->(1, "Failed to sign CSR\n")
|
||||
if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
|
||||
|
||||
my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk);
|
||||
my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req);
|
||||
|
||||
$cleanup->();
|
||||
|
||||
return wantarray ? ($req_pem, $pk_pem) : $req_pem;
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
x
Reference in New Issue
Block a user