[pve-common.git] / src / PVE / Certificate.pm

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).',
	    renderer => 'timestamp',
	    optional => 1,
	},
	notafter => {
	    type => 'integer',
	    description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
	    renderer => 'timestamp',
	    optional => 1,
	},
	san => {
	    type => 'array',
	    description => 'List of Certificate\'s SubjectAlternativeName entries.',
	    optional => 1,
	    renderer => 'yaml',
	    items => {
		type => 'string',
	    },
	},
	pem => {
	    type => 'string',
	    description => 'Certificate in PEM format',
	    format => 'pem-certificate',
	    optional => 1,
	},
	'public-key-type' => {
	    type => 'string',
	    description => 'Certificate\'s public key algorithm',
	    optional => 1,
	},
	'public-key-bits' => {
	    type => 'integer',
	    description => 'Certificate\'s public key size',
	    optional => 1,
	},
    },
});

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 $b64_char_re = qr![0-9A-Za-z\+/]!; # see RFC 7468
    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) = @_;

    $content = strip_leading_text($content);

    my $re = $pem_re->($opts{label} // 'CERTIFICATE');
    $re = qr/($re\n+)*$re/ if $opts{multiple};

    return $content if $content =~ /^$re$/; # OK

    return undef if $opts{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 sub ssl_die {
    my ($msg) = @_;
    Net::SSLeay::die_now("$msg\n");
};

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' - $!");

    my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
    Net::SSLeay::BIO_free($bio);
    die "unable to read certificate from '$cert_path'\n" if !$cert;

    return $cert;
};

sub convert_asn1_to_epoch {
    my ($asn1_time) = @_;

    ssl_die("invalid ASN1 time object") if !$asn1_time;
    my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
    ssl_die("unable to parse ASN1 time") if $iso_time eq '';
    return Date::Parse::str2time($iso_time);
}

sub get_certificate_fingerprint {
    my ($cert_path) = @_;

    my $cert = $read_certificate->($cert_path);

    my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
    Net::SSLeay::X509_free($cert);

    die "unable to get fingerprint for '$cert_path' - got empty value\n"
	if !defined($fp) || $fp eq '';

    return $fp;
}

sub assert_certificate_matches_key {
    my ($cert_path, $key_path) = @_;

    die "No certificate path given!\n" if !$cert_path;
    die "No certificate key path given!\n" if !$key_path;

    die "Certificate at '$cert_path' does not exist!\n" if ! -e $cert_path;
    die "Certificate key '$key_path' does not exist!\n" if ! -e $key_path;

    my $ctx = Net::SSLeay::CTX_new()
	or ssl_die("Failed to create SSL context in order to verify private key");

    eval {
	my $filetype = &Net::SSLeay::FILETYPE_PEM;

	Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype)
	    or ssl_die("Failed to load private key from '$key_path' into SSL context");

	Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype)
	    or ssl_die("Failed to load certificate from '$cert_path' into SSL context");

	Net::SSLeay::CTX_check_private_key($ctx)
	    or ssl_die("Failed to validate private key and certificate");
    };
    my $err = $@;

    Net::SSLeay::CTX_free($ctx);

    die $err if $err;

    return 1;
}

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');

    if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) {
	$info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
    }

    if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) {
	$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);

    my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) };
    warn $@ if $@;
    if ($pub_key) {
	$info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key));
	$info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key);
	Net::SSLeay::EVP_PKEY_free($pub_key);
    }

    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;

    # optional
    my $common_name = delete($attr{common_name}) // $san->[0];

    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 ($die_msg, $no_warn) = @_;
	Net::SSLeay::print_errs() if !$no_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") if !$name;
    my $add_name_entry = sub {
	my ($k, $v) = @_;

	my $res = Net::SSLeay::X509_NAME_add_entry_by_txt(
	    $name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v));

	$cleanup->("Failed to add '$k'='$v' to DN\n") if !$res;
    };

    $add_name_entry->('CN', $common_name);
    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->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem;

	$bio = Net::SSLeay::BIO_new($bio_s_mem);
	$cleanup->("Failed to allocate BIO for private key\n") if !$bio;

	$cleanup->("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->("Failed to read private key into EVP_PKEY\n") if !$pk;
    } else {
	$pk = Net::SSLeay::EVP_PKEY_new();
	$cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk;

	my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
	$cleanup->("Failed to generate RSA key pair\n") if !$rsa;

	$cleanup->("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->("Failed to allocate X509_REQ\n") if !$req;

    $cleanup->("Failed to set subject name\n")
	if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));

    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),
    ) or $cleanup->("Failed to add extensions to CSR\n");

    $cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);

    $cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 2);

    $cleanup->("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->(undef, 1);

    return wantarray ? ($req_pem, $pk_pem) : $req_pem;
}

1;
Commit	Line	Data
4e0952c9 FG	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).',
b99c04ad	57	renderer => 'timestamp',
4e0952c9 FG	58	optional => 1,
	59	},
	60	notafter => {
	61	type => 'integer',
	62	description => 'Certificate\'s notAfter timestamp (UNIX epoch).',
b99c04ad	63	renderer => 'timestamp',
4e0952c9 FG	64	optional => 1,
	65	},
	66	san => {
	67	type => 'array',
	68	description => 'List of Certificate\'s SubjectAlternativeName entries.',
	69	optional => 1,
b99c04ad	70	renderer => 'yaml',
4e0952c9 FG	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	},
96ab1135 AA	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	},
4e0952c9 FG	91	},
	92	});
	93
4e0952c9 FG	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
1a758ec1	105	my $b64_char_re = qr![0-9A-Za-z\+/]!; # see RFC 7468
4e0952c9 FG	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
4e0952c9 FG	136	$content = strip_leading_text($content);
4e0952c9 FG	137
6baa9131 TL	138	my $re = $pem_re->($opts{label} // 'CERTIFICATE');
6baa9131 TL	139	$re = qr/($re\n+)*$re/ if $opts{multiple};
4e0952c9	140
6baa9131	141	return $content if $content =~ /^$re$/; # OK
4e0952c9	142
6baa9131 TL	143	return undef if $opts{noerr};
6baa9131 TL	144	die "not a valid PEM-formatted string.\n";
4e0952c9 FG	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
74bb32ad	174	my sub ssl_die {
4e0952c9	175	my ($msg) = @_;
e8a515e6	176	Net::SSLeay::die_now("$msg\n");
4e0952c9 FG	177	};
4e0952c9 FG	178
4e0952c9 FG	179	my $read_certificate = sub {
	180	my ($cert_path) = @_;
	181
	182	die "'$cert_path' does not exist!\n" if ! -e $cert_path;
	183
	184	my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r')
e8a515e6	185	or ssl_die("unable to read '$cert_path' - $!");
4e0952c9 FG	186
4e0952c9 FG	187	my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
eb6262a6 SI	188	Net::SSLeay::BIO_free($bio);
eb6262a6 SI	189	die "unable to read certificate from '$cert_path'\n" if !$cert;
4e0952c9 FG	190
	191	return $cert;
	192	};
	193
	194	sub convert_asn1_to_epoch {
	195	my ($asn1_time) = @_;
	196
e8a515e6	197	ssl_die("invalid ASN1 time object") if !$asn1_time;
4e0952c9	198	my $iso_time = Net::SSLeay::P_ASN1_TIME_get_isotime($asn1_time);
e8a515e6	199	ssl_die("unable to parse ASN1 time") if $iso_time eq '';
4e0952c9 FG	200	return Date::Parse::str2time($iso_time);
	201	}
	202
4e91db0a FG	203	sub get_certificate_fingerprint {
	204	my ($cert_path) = @_;
	205
	206	my $cert = $read_certificate->($cert_path);
	207
	208	my $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
	209	Net::SSLeay::X509_free($cert);
	210
	211	die "unable to get fingerprint for '$cert_path' - got empty value\n"
	212	if !defined($fp) \|\| $fp eq '';
	213
	214	return $fp;
	215	}
	216
060a437f	217	sub assert_certificate_matches_key {
a3baf767 MC	218	my ($cert_path, $key_path) = @_;
	219
	220	die "No certificate path given!\n" if !$cert_path;
	221	die "No certificate key path given!\n" if !$key_path;
	222
	223	die "Certificate at '$cert_path' does not exist!\n" if ! -e $cert_path;
	224	die "Certificate key '$key_path' does not exist!\n" if ! -e $key_path;
	225
	226	my $ctx = Net::SSLeay::CTX_new()
74bb32ad	227	or ssl_die("Failed to create SSL context in order to verify private key");
a3baf767 MC	228
	229	eval {
	230	my $filetype = &Net::SSLeay::FILETYPE_PEM;
	231
	232	Net::SSLeay::CTX_use_PrivateKey_file($ctx, $key_path, $filetype)
74bb32ad	233	or ssl_die("Failed to load private key from '$key_path' into SSL context");
a3baf767 MC	234
a3baf767 MC	235	Net::SSLeay::CTX_use_certificate_file($ctx, $cert_path, $filetype)
74bb32ad	236	or ssl_die("Failed to load certificate from '$cert_path' into SSL context");
a3baf767 MC	237
a3baf767 MC	238	Net::SSLeay::CTX_check_private_key($ctx)
74bb32ad	239	or ssl_die("Failed to validate private key and certificate");
a3baf767 MC	240	};
	241	my $err = $@;
	242
	243	Net::SSLeay::CTX_free($ctx);
	244
	245	die $err if $err;
	246
	247	return 1;
	248	}
	249
4e0952c9 FG	250	sub get_certificate_info {
	251	my ($cert_path) = @_;
	252
	253	my $cert = $read_certificate->($cert_path);
	254
	255	my $parse_san = sub {
	256	my $res = [];
	257	while (my ($type, $value) = splice(@_, 0, 2)) {
	258	if ($type != 2 && $type != 7) {
	259	warn "unexpected SAN type encountered: $type\n";
	260	next;
	261	}
	262
	263	if ($type == 7) {
	264	my $hex = unpack("H*", $value);
	265	if (length($hex) == 8) {
	266	# IPv4
	267	$value = join(".", unpack("C4C4C4C4", $value));
	268	} elsif (length($hex) == 32) {
	269	# IPv6
	270	$value = join(":", unpack("H4H4H4H4H4H4H4H4", $value));
	271	} else {
	272	warn "cannot parse SAN IP entry '0x${hex}'\n";
	273	next;
	274	}
	275	}
	276
	277	push @$res, $value;
	278	}
	279	return $res;
	280	};
	281
	282	my $info = {};
	283
	284	$info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
	285
060a437f	286	if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) {
4e0952c9 FG	287	$info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
	288	}
	289
060a437f	290	if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) {
4e0952c9 FG	291	$info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
	292	}
	293
	294	eval { $info->{notbefore} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notBefore($cert)) };
	295	warn $@ if $@;
	296	eval { $info->{notafter} = convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
	297	warn $@ if $@;
	298
	299	$info->{san} = $parse_san->(Net::SSLeay::X509_get_subjectAltNames($cert));
	300	$info->{pem} = Net::SSLeay::PEM_get_string_X509($cert);
	301
afa3f369 FG	302	my $pub_key = eval { Net::SSLeay::X509_get_pubkey($cert) };
	303	warn $@ if $@;
	304	if ($pub_key) {
	305	$info->{'public-key-type'} = Net::SSLeay::OBJ_nid2sn(Net::SSLeay::EVP_PKEY_id($pub_key));
	306	$info->{'public-key-bits'} = Net::SSLeay::EVP_PKEY_bits($pub_key);
	307	Net::SSLeay::EVP_PKEY_free($pub_key);
	308	}
	309
4e0952c9 FG	310	Net::SSLeay::X509_free($cert);
	311
	312	$cert_path =~ s!^.*/!!g;
	313	$info->{filename} = $cert_path;
	314
	315	return $info;
	316	};
	317
	318	# Checks whether certificate expires before $timestamp (UNIX epoch)
	319	sub check_expiry {
	320	my ($cert_path, $timestamp) = @_;
	321
	322	$timestamp //= time();
	323
	324	my $cert = $read_certificate->($cert_path);
	325	my $not_after = eval { convert_asn1_to_epoch(Net::SSLeay::X509_get_notAfter($cert)) };
	326	my $err = $@;
	327
	328	Net::SSLeay::X509_free($cert);
	329
	330	die $err if $err;
	331
	332	return ($not_after < $timestamp) ? 1 : 0;
	333	};
	334
	335	# Create a CSR and certificate key for a given order
	336	# returns path to CSR file or path to CSR and key files
	337	sub generate_csr {
	338	my (%attr) = @_;
	339
	340	# optional
	341	my $bits = delete($attr{bits}) // 4096;
	342	my $dig_alg = delete($attr{digest}) // 'sha256';
	343	my $pem_key = delete($attr{private_key});
	344
	345	# required
	346	my $identifiers = delete($attr{identifiers});
	347
	348	die "Identifiers are required to generate a CSR.\n"
	349	if !defined($identifiers);
	350
	351	my $san = [ map { $_->{value} } grep { $_->{type} eq 'dns' } @$identifiers ];
	352	die "DNS identifiers are required to generate a CSR.\n" if !scalar @$san;
	353
0e4d81ad TL	354	# optional
	355	my $common_name = delete($attr{common_name}) // $san->[0];
	356
4e0952c9 FG	357	my $md = eval { Net::SSLeay::EVP_get_digestbyname($dig_alg) };
	358	die "Invalid digest algorithm '$dig_alg'\n" if !$md;
	359
	360	my ($bio, $pk, $req);
	361
	362	my $cleanup = sub {
45a75161 TL	363	my ($die_msg, $no_warn) = @_;
45a75161 TL	364	Net::SSLeay::print_errs() if !$no_warn;
4e0952c9 FG	365
	366	Net::SSLeay::X509_REQ_free($req) if $req;
	367	Net::SSLeay::EVP_PKEY_free($pk) if $pk;
	368	Net::SSLeay::BIO_free($bio) if $bio;
	369
	370	die $die_msg if $die_msg;
	371	};
	372
	373	# this unfortunately causes a small memory leak, since there is no
	374	# X509_NAME_free() (yet)
	375	my $name = Net::SSLeay::X509_NAME_new();
e8a515e6	376	ssl_die("Failed to allocate X509_NAME object") if !$name;
4e0952c9 FG	377	my $add_name_entry = sub {
4e0952c9 FG	378	my ($k, $v) = @_;
d602284c MC	379
d602284c MC	380	my $res = Net::SSLeay::X509_NAME_add_entry_by_txt(
45a75161	381	$name, $k, &Net::SSLeay::MBSTRING_UTF8, encode('utf-8', $v));
d602284c	382
45a75161	383	$cleanup->("Failed to add '$k'='$v' to DN\n") if !$res;
4e0952c9 FG	384	};
4e0952c9 FG	385
0e4d81ad	386	$add_name_entry->('CN', $common_name);
4e0952c9	387	for (qw(C ST L O OU)) {
d602284c	388	if (defined(my $v = $attr{$_})) {
4e0952c9	389	$add_name_entry->($_, $v);
d602284c	390	}
4e0952c9 FG	391	}
	392
	393	if (defined($pem_key)) {
	394	my $bio_s_mem = Net::SSLeay::BIO_s_mem();
45a75161	395	$cleanup->("Failed to allocate BIO_s_mem for private key\n") if !$bio_s_mem;
4e0952c9 FG	396
4e0952c9 FG	397	$bio = Net::SSLeay::BIO_new($bio_s_mem);
45a75161	398	$cleanup->("Failed to allocate BIO for private key\n") if !$bio;
4e0952c9	399
45a75161	400	$cleanup->("Failed to write PEM-encoded key to BIO\n")
4e0952c9 FG	401	if Net::SSLeay::BIO_write($bio, $pem_key) <= 0;
	402
	403	$pk = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
45a75161	404	$cleanup->("Failed to read private key into EVP_PKEY\n") if !$pk;
4e0952c9 FG	405	} else {
4e0952c9 FG	406	$pk = Net::SSLeay::EVP_PKEY_new();
45a75161	407	$cleanup->("Failed to allocate EVP_PKEY for private key\n") if !$pk;
4e0952c9 FG	408
4e0952c9 FG	409	my $rsa = Net::SSLeay::RSA_generate_key($bits, 65537);
45a75161	410	$cleanup->("Failed to generate RSA key pair\n") if !$rsa;
4e0952c9	411
45a75161	412	$cleanup->("Failed to assign RSA key to EVP_PKEY\n")
4e0952c9 FG	413	if !Net::SSLeay::EVP_PKEY_assign_RSA($pk, $rsa);
	414	}
	415
	416	$req = Net::SSLeay::X509_REQ_new();
45a75161	417	$cleanup->("Failed to allocate X509_REQ\n") if !$req;
4e0952c9	418
45a75161	419	$cleanup->("Failed to set subject name\n")
4e0952c9 FG	420	if (!Net::SSLeay::X509_REQ_set_subject_name($req, $name));
4e0952c9 FG	421
d602284c MC	422	Net::SSLeay::P_X509_REQ_add_extensions(
	423	$req,
	424	&Net::SSLeay::NID_key_usage => 'digitalSignature,keyEncipherment',
	425	&Net::SSLeay::NID_basic_constraints => 'CA:FALSE',
	426	&Net::SSLeay::NID_ext_key_usage => 'serverAuth,clientAuth',
	427	&Net::SSLeay::NID_subject_alt_name => join(',', map { "DNS:$_" } @$san),
45a75161	428	) or $cleanup->("Failed to add extensions to CSR\n");
4e0952c9	429
45a75161	430	$cleanup->("Failed to set public key\n") if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
4e0952c9	431
45a75161	432	$cleanup->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 2);
4e0952c9	433
45a75161	434	$cleanup->("Failed to sign CSR\n") if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
4e0952c9 FG	435
	436	my $pk_pem = Net::SSLeay::PEM_get_string_PrivateKey($pk);
	437	my $req_pem = Net::SSLeay::PEM_get_string_X509_REQ($req);
	438
45a75161	439	$cleanup->(undef, 1);
4e0952c9 FG	440
	441	return wantarray ? ($req_pem, $pk_pem) : $req_pem;
	442	}
	443
	444	1;