},
});
-# 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 $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);
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);
+ my $re = $pem_re->($opts{label} // 'CERTIFICATE');
+ $re = qr/($re\n+)*$re/ if $opts{multiple};
- $re = qr/($re\n+)*$re/ if $multiple;
+ return $content if $content =~ /^$re$/; # OK
- if ($content =~ /^$re$/) {
- return $content;
- } else {
- return undef if $noerr;
- die "not a valid PEM-formatted string.\n";
- }
+ return undef if $opts{noerr};
+ die "not a valid PEM-formatted string.\n";
}
sub pem_to_der {
return "-----BEGIN $label-----\n$b64\n-----END $label-----\n";
}
-my $ssl_die = sub {
+my sub ssl_die {
my ($msg) = @_;
- Net::SSLeay::die_now($msg);
-};
-
-my $ssl_warn = sub {
- my ($msg) = @_;
- Net::SSLeay::print_errs();
- warn $msg if $msg;
+ warn Net::SSLeay::print_errs();
+ Net::SSLeay::die_now("$msg\n");
};
my $read_certificate = sub {
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");
+ or ssl_die("unable to read '$cert_path' - $!");
my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
Net::SSLeay::BIO_free($bio);
sub convert_asn1_to_epoch {
my ($asn1_time) = @_;
- $ssl_die->("invalid ASN1 time object\n") if !$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\n") if $iso_time eq '';
+ ssl_die("unable to parse ASN1 time") if $iso_time eq '';
return Date::Parse::str2time($iso_time);
}
return $fp;
}
-sub certificate_matches_key {
+sub assert_certificate_matches_key {
my ($cert_path, $key_path) = @_;
die "No certificate path given!\n" if !$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"
- );
+ 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"
- );
+ 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"
- );
+ 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"
- );
+ or ssl_die("Failed to validate private key and certificate");
};
my $err = $@;
$info->{fingerprint} = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
- my $subject = Net::SSLeay::X509_get_subject_name($cert);
- if ($subject) {
+ if (my $subject = Net::SSLeay::X509_get_subject_name($cert)) {
$info->{subject} = Net::SSLeay::X509_NAME_oneline($subject);
}
- my $issuer = Net::SSLeay::X509_get_issuer_name($cert);
- if ($issuer) {
+ if (my $issuer = Net::SSLeay::X509_get_issuer_name($cert)) {
$info->{issuer} = Net::SSLeay::X509_NAME_oneline($issuer);
}
my ($bio, $pk, $req);
my $cleanup = sub {
- my ($warn, $die_msg) = @_;
- $ssl_warn->() if $warn;
+ 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;
# 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;
+ ssl_die("Failed to allocate X509_NAME object") 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");
- }
+
+ 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{$_})) {
+ 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;
+ $cleanup->("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->("Failed to allocate BIO for private key\n") if !$bio;
- $cleanup->(1, "Failed to write PEM-encoded key to BIO\n")
+ $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->(1, "Failed to read private key into EVP_PKEY\n") if !$pk;
+ $cleanup->("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;
+ $cleanup->("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->("Failed to generate RSA key pair\n") if !$rsa;
- $cleanup->(1, "Failed to assign RSA key to EVP_PKEY\n")
+ $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->(1, "Failed to allocate X509_REQ\n") if !$req;
+ $cleanup->("Failed to allocate X509_REQ\n") if !$req;
- $cleanup->(1, "Failed to set subject name\n")
+ $cleanup->("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),
- );
+ 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->(1, "Failed to set public key\n")
- if !Net::SSLeay::X509_REQ_set_pubkey($req, $pk);
+ $cleanup->("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->("Failed to set CSR version\n") if !Net::SSLeay::X509_REQ_set_version($req, 0);
- $cleanup->(1, "Failed to sign CSR\n")
- if !Net::SSLeay::X509_REQ_sign($req, $pk, $md);
+ $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->();
+ $cleanup->(undef, 1);
return wantarray ? ($req_pem, $pk_pem) : $req_pem;
}