package IO::Socket::SSL::Utils;
use strict;
use warnings;
use Carp 'croak';
use Net::SSLeay;
# old versions of Exporter do not export 'import' yet
require Exporter;
*import = \&Exporter::import;
our $VERSION = '2.014';
our @EXPORT = qw(
PEM_file2cert PEM_string2cert PEM_cert2file PEM_cert2string
PEM_file2key PEM_string2key PEM_key2file PEM_key2string
KEY_free CERT_free
KEY_create_rsa CERT_asHash CERT_create
);
sub PEM_file2cert {
my $file = shift;
my $bio = Net::SSLeay::BIO_new_file($file,'r') or
croak "cannot read $file: $!";
my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
Net::SSLeay::BIO_free($bio);
$cert or croak "cannot parse $file as PEM X509 cert: ".
Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
return $cert;
}
sub PEM_cert2file {
my ($cert,$file) = @_;
my $string = Net::SSLeay::PEM_get_string_X509($cert)
or croak("cannot get string from cert");
open( my $fh,'>',$file ) or croak("cannot write $file: $!");
print $fh $string;
}
sub PEM_string2cert {
my $string = shift;
my $bio = Net::SSLeay::BIO_new( Net::SSLeay::BIO_s_mem());
Net::SSLeay::BIO_write($bio,$string);
my $cert = Net::SSLeay::PEM_read_bio_X509($bio);
Net::SSLeay::BIO_free($bio);
$cert or croak "cannot parse string as PEM X509 cert: ".
Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
return $cert;
}
sub PEM_cert2string {
my $cert = shift;
return Net::SSLeay::PEM_get_string_X509($cert)
|| croak("cannot get string from cert");
}
sub PEM_file2key {
my $file = shift;
my $bio = Net::SSLeay::BIO_new_file($file,'r') or
croak "cannot read $file: $!";
my $cert = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
Net::SSLeay::BIO_free($bio);
$cert or croak "cannot parse $file as PEM private key: ".
Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
return $cert;
}
sub PEM_key2file {
my ($key,$file) = @_;
my $string = Net::SSLeay::PEM_get_string_PrivateKey($key)
or croak("cannot get string from key");
open( my $fh,'>',$file ) or croak("cannot write $file: $!");
print $fh $string;
}
sub PEM_string2key {
my $string = shift;
my $bio = Net::SSLeay::BIO_new( Net::SSLeay::BIO_s_mem());
Net::SSLeay::BIO_write($bio,$string);
my $cert = Net::SSLeay::PEM_read_bio_PrivateKey($bio);
Net::SSLeay::BIO_free($bio);
$cert or croak "cannot parse string as PEM private key: ".
Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error());
return $cert;
}
sub PEM_key2string {
my $key = shift;
return Net::SSLeay::PEM_get_string_PrivateKey($key)
|| croak("cannot get string from key");
}
sub CERT_free {
my $cert = shift or return;
Net::SSLeay::X509_free($cert);
}
sub KEY_free {
my $key = shift or return;
Net::SSLeay::EVP_PKEY_free($key);
}
sub KEY_create_rsa {
my $bits = shift || 2048;
my $key = Net::SSLeay::EVP_PKEY_new();
my $rsa = Net::SSLeay::RSA_generate_key($bits, 0x10001); # 0x10001 = RSA_F4
Net::SSLeay::EVP_PKEY_assign_RSA($key,$rsa);
return $key;
}
# extract information from cert
my %gen2i = qw( OTHERNAME 0 EMAIL 1 DNS 2 X400 3 DIRNAME 4 EDIPARTY 5 URI 6 IP 7 RID 8 );
my %i2gen = reverse %gen2i;
sub CERT_asHash {
my $cert = shift;
my $digest_name = shift || 'sha256';
my %hash = (
version => Net::SSLeay::X509_get_version($cert),
not_before => _asn1t2t(Net::SSLeay::X509_get_notBefore($cert)),
not_after => _asn1t2t(Net::SSLeay::X509_get_notAfter($cert)),
serial => Net::SSLeay::ASN1_INTEGER_get(
Net::SSLeay::X509_get_serialNumber($cert)),
crl_uri => [ Net::SSLeay::P_X509_get_crl_distribution_points($cert) ],
keyusage => [ Net::SSLeay::P_X509_get_key_usage($cert) ],
extkeyusage => {
oid => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,0) ],
nid => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,1) ],
sn => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,2) ],
ln => [ Net::SSLeay::P_X509_get_ext_key_usage($cert,3) ],
},
"pubkey_digest_$digest_name" => Net::SSLeay::X509_pubkey_digest(
$cert,_digest($digest_name)),
"x509_digest_$digest_name" => Net::SSLeay::X509_digest(
$cert,_digest($digest_name)),
"fingerprint_$digest_name" => Net::SSLeay::X509_get_fingerprint(
$cert,_digest($digest_name)),
);
my $subj = Net::SSLeay::X509_get_subject_name($cert);
my %subj;
for ( 0..Net::SSLeay::X509_NAME_entry_count($subj)-1 ) {
my $e = Net::SSLeay::X509_NAME_get_entry($subj,$_);
my $o = Net::SSLeay::X509_NAME_ENTRY_get_object($e);
$subj{ Net::SSLeay::OBJ_obj2txt($o) } =
Net::SSLeay::P_ASN1_STRING_get(
Net::SSLeay::X509_NAME_ENTRY_get_data($e));
}
$hash{subject} = \%subj;
if ( my @names = Net::SSLeay::X509_get_subjectAltNames($cert) ) {
my $alt = $hash{subjectAltNames} = [];
while (my ($t,$v) = splice(@names,0,2)) {
$t = $i2gen{$t} || die "unknown type $t in subjectAltName";
if ( $t eq 'IP' ) {
if (length($v) == 4) {
$v = join('.',unpack("CCCC",$v));
} elsif ( length($v) == 16 ) {
$v = join(':',map { sprintf( "%x",$_) } unpack("NNNN",$v));
}
}
push @$alt,[$t,$v]
}
}
my $issuer = Net::SSLeay::X509_get_issuer_name($cert);
my %issuer;
for ( 0..Net::SSLeay::X509_NAME_entry_count($issuer)-1 ) {
my $e = Net::SSLeay::X509_NAME_get_entry($issuer,$_);
my $o = Net::SSLeay::X509_NAME_ENTRY_get_object($e);
$issuer{ Net::SSLeay::OBJ_obj2txt($o) } =
Net::SSLeay::P_ASN1_STRING_get(
Net::SSLeay::X509_NAME_ENTRY_get_data($e));
}
$hash{issuer} = \%issuer;
my @ext;
for( 0..Net::SSLeay::X509_get_ext_count($cert)-1 ) {
my $e = Net::SSLeay::X509_get_ext($cert,$_);
my $o = Net::SSLeay::X509_EXTENSION_get_object($e);
my $nid = Net::SSLeay::OBJ_obj2nid($o);
push @ext, {
oid => Net::SSLeay::OBJ_obj2txt($o),
nid => ( $nid > 0 ) ? $nid : undef,
sn => ( $nid > 0 ) ? Net::SSLeay::OBJ_nid2sn($nid) : undef,
critical => Net::SSLeay::X509_EXTENSION_get_critical($e),
data => Net::SSLeay::X509V3_EXT_print($e),
}
}
$hash{ext} = \@ext;
if ( defined(&Net::SSLeay::P_X509_get_ocsp_uri)) {
$hash{ocsp_uri} = [ Net::SSLeay::P_X509_get_ocsp_uri($cert) ];
} else {
$hash{ocsp_uri} = [];
for( @ext ) {
$_->{sn} or next;
$_->{sn} eq 'authorityInfoAccess' or next;
push @{ $hash{ocsp_uri}}, $_->{data} =~m{\bOCSP - URI:(\S+)}g;
}
}
return \%hash;
}
sub CERT_create {
my %args = @_%2 ? %{ shift() } : @_;
my $cert = Net::SSLeay::X509_new();
my $digest_name = delete $args{digest} || 'sha256';
Net::SSLeay::ASN1_INTEGER_set(
Net::SSLeay::X509_get_serialNumber($cert),
delete $args{serial} || rand(2**32),
);
# version default to 2 (V3)
Net::SSLeay::X509_set_version($cert,
delete $args{version} || 2 );
# not_before default to now
Net::SSLeay::ASN1_TIME_set(
Net::SSLeay::X509_get_notBefore($cert),
delete $args{not_before} || time()
);
# not_after default to now+365 days
Net::SSLeay::ASN1_TIME_set(
Net::SSLeay::X509_get_notAfter($cert),
delete $args{not_after} || time() + 365*86400
);
# set subject
my $subj_e = Net::SSLeay::X509_get_subject_name($cert);
my $subj = delete $args{subject} || {
organizationName => 'IO::Socket::SSL',
commonName => 'IO::Socket::SSL Test'
};
while ( my ($k,$v) = each %$subj ) {
# 0x1000 = MBSTRING_UTF8
Net::SSLeay::X509_NAME_add_entry_by_txt($subj_e,
$k, 0x1000, $v, -1, 0)
or croak("failed to add entry for $k - ".
Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()));
}
my @ext = (
&Net::SSLeay::NID_subject_key_identifier => 'hash',
&Net::SSLeay::NID_authority_key_identifier => 'keyid',
&Net::SSLeay::NID_authority_key_identifier => 'issuer',
);
if ( my $altsubj = delete $args{subjectAltNames} ) {
push @ext,
&Net::SSLeay::NID_subject_alt_name =>
join(',', map { "$_->[0]:$_->[1]" } @$altsubj)
}
my $key = delete $args{key} || KEY_create_rsa();
Net::SSLeay::X509_set_pubkey($cert,$key);
my $is = delete $args{issuer};
my $issuer_cert = delete $args{issuer_cert} || $is && $is->[0] || $cert;
my $issuer_key = delete $args{issuer_key} || $is && $is->[1] || $key;
my %purpose;
if (my $p = delete $args{purpose}) {
if (!ref($p)) {
$purpose{lc($2)} = (!$1 || $1 eq '+') ? 1:0
while $p =~m{([+-]?)(\w+)}g;
} elsif (ref($p) eq 'ARRAY') {
for(@$p) {
m{^([+-]?)(\w+)$} or die "invalid entry in purpose: $_";
$purpose{lc($2)} = (!$1 || $1 eq '+') ? 1:0
}
} else {
while( my ($k,$v) = each %$p) {
$purpose{lc($k)} = ($v && $v ne '-')?1:0;
}
}
}
if (defined( my $ca = delete $args{CA})) {
# add defaults
if ($ca) {
%purpose = (
ca => 1, sslca => 1, emailca => 1, objca => 1,
%purpose
);
} else {
%purpose = (
server => 1, client => 1,
%purpose
);
}
} elsif (!%purpose) {
%purpose = (server => 1, client => 1);
}
my (%key_usage,%ext_key_usage,%cert_type,%basic_constraints);
my %dS = ( digitalSignature => \%key_usage );
my %kE = ( keyEncipherment => \%key_usage );
my %CA = ( 'CA:TRUE' => \%basic_constraints, %dS, keyCertSign => \%key_usage );
for(
[ client => { %dS, %kE, clientAuth => \%ext_key_usage, client => \%cert_type } ],
[ server => { %dS, %kE, serverAuth => \%ext_key_usage, server => \%cert_type } ],
[ email => { %dS, %kE, emailProtection => \%ext_key_usage, email => \%cert_type } ],
[ objsign => { %dS, %kE, codeSigning => \%ext_key_usage, objsign => \%cert_type } ],
[ CA => { %CA }],
[ sslCA => { %CA, sslCA => \%cert_type }],
[ emailCA => { %CA, emailCA => \%cert_type }],
[ objCA => { %CA, objCA => \%cert_type }],
[ emailProtection => { %dS, %kE, emailProtection => \%ext_key_usage, email => \%cert_type } ],
[ codeSigning => { %dS, %kE, codeSigning => \%ext_key_usage, objsign => \%cert_type } ],
[ timeStamping => { timeStamping => \%ext_key_usage } ],
[ digitalSignature => { digitalSignature => \%key_usage } ],
[ nonRepudiation => { nonRepudiation => \%key_usage } ],
[ keyEncipherment => { keyEncipherment => \%key_usage } ],
[ dataEncipherment => { dataEncipherment => \%key_usage } ],
[ keyAgreement => { keyAgreement => \%key_usage } ],
[ keyCertSign => { keyCertSign => \%key_usage } ],
[ cRLSign => { cRLSign => \%key_usage } ],
[ encipherOnly => { encipherOnly => \%key_usage } ],
[ decipherOnly => { decipherOnly => \%key_usage } ],
) {
delete $purpose{lc($_->[0])} or next;
while (my($k,$h) = each %{$_->[1]}) {
$h->{$k} = 1;
}
}
die "unknown purpose ".join(",",keys %purpose) if %purpose;
if (%basic_constraints) {
push @ext,&Net::SSLeay::NID_basic_constraints,
=> join(",",'critical', sort keys %basic_constraints);
} else {
push @ext, &Net::SSLeay::NID_basic_constraints => 'CA:FALSE';
}
push @ext,&Net::SSLeay::NID_key_usage
=> join(",",'critical', sort keys %key_usage) if %key_usage;
push @ext,&Net::SSLeay::NID_netscape_cert_type
=> join(",",sort keys %cert_type) if %cert_type;
push @ext,&Net::SSLeay::NID_ext_key_usage
=> join(",",sort keys %ext_key_usage) if %ext_key_usage;
Net::SSLeay::P_X509_add_extensions($cert, $issuer_cert, @ext);
for my $ext (@{ $args{ext} || [] }) {
my $nid = $ext->{nid}
|| $ext->{sn} && Net::SSLeay::OBJ_sn2nid($ext->{sn})
|| croak "cannot determine NID of extension";
my $val = $ext->{data};
if ($nid == 177) {
# authorityInfoAccess:
# OpenSSL i2v does not output the same way as expected by i2v :(
for (split(/\n/,$val)) {
s{ - }{;}; # "OCSP - URI:..." -> "OCSP;URI:..."
$_ = "critical,$_" if $ext->{critical};
Net::SSLeay::P_X509_add_extensions($cert,$issuer_cert,$nid,$_);
}
} else {
$val = "critical,$val" if $ext->{critical};
Net::SSLeay::P_X509_add_extensions($cert, $issuer_cert, $nid, $val);
}
}
Net::SSLeay::X509_set_issuer_name($cert,
Net::SSLeay::X509_get_subject_name($issuer_cert));
Net::SSLeay::X509_sign($cert,$issuer_key,_digest($digest_name));
return ($cert,$key);
}
if ( defined &Net::SSLeay::ASN1_TIME_timet ) {
*_asn1t2t = \&Net::SSLeay::ASN1_TIME_timet
} else {
require Time::Local;
my %mon2i = qw(
Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11
);
*_asn1t2t = sub {
my $t = Net::SSLeay::P_ASN1_TIME_put2string( shift );
my ($mon,$d,$h,$m,$s,$y,$tz) = split(/[\s:]+/,$t);
defined( $mon = $mon2i{$mon} ) or die "invalid month in $t";
$tz ||= $y =~s{^(\d+)([A-Z]\S*)}{$1} && $2;
if ( ! $tz ) {
return Time::Local::timelocal($s,$m,$h,$d,$mon,$y)
} elsif ( $tz eq 'GMT' ) {
return Time::Local::timegm($s,$m,$h,$d,$mon,$y)
} else {
die "unexpected TZ $tz from ASN1_TIME_print";
}
}
}
{
my %digest;
sub _digest {
my $digest_name = shift;
return $digest{$digest_name} ||= do {
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::EVP_get_digestbyname($digest_name)
or die "Digest algorithm $digest_name is not available";
};
}
}
1;
__END__
=head1 NAME
IO::Socket::SSL::Utils -- loading, storing, creating certificates and keys
=head1 SYNOPSIS
use IO::Socket::SSL::Utils;
my $cert = PEM_file2cert('cert.pem'); # load certificate from file
my $string = PEM_cert2string($cert); # convert certificate to PEM string
CERT_free($cert); # free memory within OpenSSL
my $key = KEY_create_rsa(2048); # create new 2048-bit RSA key
PEM_string2file($key,"key.pem"); # and write it to file
KEY_free($key); # free memory within OpenSSL
=head1 DESCRIPTION
This module provides various utility functions to work with certificates and
private keys, shielding some of the complexity of the underlying Net::SSLeay and
OpenSSL.
=head1 FUNCTIONS
=over 4
=item *
Functions converting between string or file and certificates and keys.
They croak if the operation cannot be completed.
=over 8
=item PEM_file2cert(file) -> cert
=item PEM_cert2file(cert,file)
=item PEM_string2cert(string) -> cert
=item PEM_cert2string(cert) -> string
=item PEM_file2key(file) -> key
=item PEM_key2file(key,file)
=item PEM_string2key(string) -> key
=item PEM_key2string(key) -> string
=back
=item *
Functions for cleaning up.
Each loaded or created cert and key must be freed to not leak memory.
=over 8
=item CERT_free(cert)
=item KEY_free(key)
=back
=item * KEY_create_rsa(bits) -> key
Creates an RSA key pair, bits defaults to 2048.
=item * CERT_asHash(cert,[digest_algo]) -> hash
Extracts the information from the certificate into a hash and uses the given
digest_algo (default: SHA-256) to determine digest of pubkey and cert.
The resulting hash contains:
=over 8
=item subject
Hash with the parts of the subject, e.g. commonName, countryName,
organizationName, stateOrProvinceName, localityName.
=item subjectAltNames
Array with list of alternative names. Each entry in the list is of
C<[type,value]>, where C<type> can be OTHERNAME, EMAIL, DNS, X400, DIRNAME,
EDIPARTY, URI, IP or RID.
=item issuer
Hash with the parts of the issuer, e.g. commonName, countryName,
organizationName, stateOrProvinceName, localityName.
=item not_before, not_after
The time frame, where the certificate is valid, as time_t, e.g. can be converted
with localtime or similar functions.
=item serial
The serial number
=item crl_uri
List of URIs for CRL distribution.
=item ocsp_uri
List of URIs for revocation checking using OCSP.
=item keyusage
List of keyUsage information in the certificate.
=item extkeyusage
List of extended key usage information from the certificate. Each entry in
this list consists of a hash with oid, nid, ln and sn.
=item pubkey_digest_xxx
Binary digest of the pubkey using the given digest algorithm, e.g.
pubkey_digest_sha256 if (the default) SHA-256 was used.
=item x509_digest_xxx
Binary digest of the X.509 certificate using the given digest algorithm, e.g.
x509_digest_sha256 if (the default) SHA-256 was used.
=item fingerprint_xxx
Fingerprint of the certificate using the given digest algorithm, e.g.
fingerprint_sha256 if (the default) SHA-256 was used. Contrary to digest_* this
is an ASCII string with a list if hexadecimal numbers, e.g.
"73:59:75:5C:6D...".
=item ext
List of extensions.
Each entry in the list is a hash with oid, nid, sn, critical flag (boolean) and
data (string representation given by X509V3_EXT_print).
=item version
Certificate version, usually 2 (x509v3)
=back
=item * CERT_create(hash) -> (cert,key)
Creates a certificate based on the given hash.
If the issuer is not specified the certificate will be self-signed.
The following keys can be given:
=over 8
=item subject
Hash with the parts of the subject, e.g. commonName, countryName, ... as
described in C<CERT_asHash>.
Default points to IO::Socket::SSL.
=item not_before
A time_t value when the certificate starts to be valid. Defaults to current
time.
=item not_after
A time_t value when the certificate ends to be valid. Defaults to current
time plus one 365 days.
=item serial
The serial number. If not given a random number will be used.
=item version
The version of the certificate, default 2 (x509v3).
=item CA true|false
If true declare certificate as CA, defaults to false.
=item purpose string|array|hash
Set the purpose of the certificate.
The different purposes can be given as a string separated by non-word character,
as array or hash. With string or array each purpose can be prefixed with '+'
(enable) or '-' (disable) and same can be done with the value when given as a
hash. By default enabling the purpose is assumed.
If the CA option is given and true the defaults "ca,sslca,emailca,objca" are
assumed, but can be overridden with explicit purpose.
If the CA option is given and false the defaults "server,client" are assumed.
If no CA option and no purpose is given it defaults to "server,client".
Purpose affects basicConstraints, keyUsage, extKeyUsage and netscapeCertType.
The following purposes are defined (case is not important):
client
server
email
objsign
CA
sslCA
emailCA
objCA
emailProtection
codeSigning
timeStamping
digitalSignature
nonRepudiation
keyEncipherment
dataEncipherment
keyAgreement
keyCertSign
cRLSign
encipherOnly
decipherOnly
Examples:
# root-CA for SSL certificates
purpose => 'sslCA' # or CA => 1
# server certificate and CA (typically self-signed)
purpose => 'sslCA,server'
# client certificate
purpose => 'client',
=item ext [{ sn => .., data => ... }, ... ]
List of extensions. The type of the extension can be specified as name with
C<sn> or as NID with C<nid> and the data with C<data>. These data must be in the
same syntax as expected within openssl.cnf, e.g. something like
C<OCSP;URI=http://...>. Additionally the critical flag can be set with
C<critical => 1>.
=item key key
use given key as key for certificate, otherwise a new one will be generated and
returned
=item issuer_cert cert
set issuer for new certificate
=item issuer_key key
sign new certificate with given key
=item issuer [ cert, key ]
Instead of giving issuer_key and issuer_cert as separate arguments they can be
given both together.
=item digest algorithm
specify the algorithm used to sign the certificate, default SHA-256.
=back
=back
=head1 AUTHOR
Steffen Ullrich