Crypt-OpenSSL-CA
view release on metacpan or search on metacpan
lib/Crypt/OpenSSL/CA.pm view on Meta::CPAN
#!perl -w
# -*- coding: utf-8; -*-
use strict;
use warnings;
package Crypt::OpenSSL::CA;
our $VERSION = "0.91";
# Maintainer note: Inline::C doesn't like pre-releases (eg 0.21_01), which are not needed
# for PAUSE developer releases anyway (http://www.cpan.org/modules/04pause.html#developerreleases)
=head1 NAME
Crypt::OpenSSL::CA - The crypto parts of an X509v3 Certification Authority
=head1 SYNOPSIS
=for My::Tests::Below "synopsis" begin
use Crypt::OpenSSL::CA;
my $dn = Crypt::OpenSSL::CA::X509_NAME->new
(C => "fr", CN => "test");
my $privkey = Crypt::OpenSSL::CA::PrivateKey
->parse($pem_private_key, -password => "secret");
my $pubkey = $privkey->get_public_key;
my $x509 = Crypt::OpenSSL::CA::X509->new($pubkey);
$x509->set_serial("0xdeadbeef");
$x509->set_subject_DN($dn);
$x509->set_issuer_DN($dn);
$x509->set_extension("basicConstraints", "CA:TRUE",
-critical => 1);
$x509->set_extension("subjectKeyIdentifier",
$pubkey->get_openssl_keyid);
$x509->set_extension("authorityKeyIdentifier",
{ keyid => $pubkey->get_openssl_keyid });
my $pem = $x509->sign($privkey, "sha1");
=for My::Tests::Below "synopsis" end
=head1 DESCRIPTION
This module performs the cryptographic operations necessary to issue
X509 certificates and certificate revocation lists (CRLs). It is
implemented as a Perl wrapper around the popular OpenSSL library.
I<Crypt::OpenSSL::CA> is an essential building block to create an
X509v3 B<Certification Authority> or CA, a crucial part of an X509
Public Key Infrastructure (PKI). A CA is defined by RFC4210 and
friends (see L<Crypt::OpenSSL::CA::Resources>) as a piece of software
that can (among other things) issue and revoke X509v3 certificates.
To perform the necessary cryptographic operations, it needs a private
key that is kept secret (currently only RSA is supported).
Despite the name and unlike the C<openssl ca> command-line tool,
I<Crypt::OpenSSL::CA> is not designed as a full-fledged X509v3
Certification Authority (CA) in and of itself: some key features are
missing, most notably persistence (e.g. to remember issued and revoked
certificates between two CRL issuances) and security-policy based
screening of certificate requests. I<Crypt::OpenSSL::CA> mostly does
``just the crypto'', and this is deliberate: OpenSSL's features such
as configuration file parsing, that are best implemented in Perl, have
been left out for maximum flexibility.
=head2 API Overview
The crypto in I<Crypt::OpenSSL::CA> is implemented using the OpenSSL
cryptographic library, which is lifted to Perl thanks to a bunch of
glue code in C and a lot of magic in L<Inline::C> and
L<Crypt::OpenSSL::CA::Inline::C>.
Most of said glue code is accessible as class and instance methods in
the ancillary classes such as L</Crypt::OpenSSL::CA::X509> and
L</Crypt::OpenSSL::CA::X509_CRL>; the parent namespace
I<Crypt::OpenSSL::CA> is basically empty. Each of these ancillary
classes wrap around OpenSSL's ``object class'' with the same name
(e.g. L</Crypt::OpenSSL::CA::X509_NAME> corresponds to the
C<X509_NAME_foo> functions in C<libcrypto.so>). OpenSSL concepts are
therefore made available in an elegant object-oriented API; moreover,
they are subjugated to Perl's automatic garbage collection, which
allows the programmer to stop worrying about that. Additionally,
I<Crypt::OpenSSL::CA> provides some glue in Perl too, which is mostly
syntactic sugar to get a more Perlish API out of the C in OpenSSL.
lib/Crypt/OpenSSL/CA.pm view on Meta::CPAN
Parses a private key $pemkey and returns an instance of
I<Crypt::OpenSSL::CA::PrivateKey>. Available named options are:
=over
=item I<< -password => $password >>
Tells that $pemkey is a software key encrypted with password
$password.
=back
Only software keys are supported for now (see L</TODO> about engine
support).
=cut
sub parse {
croak("incorrect number of arguments to parse()")
if (@_ % 2);
my ($self, $keytext, %options) = @_;
if (defined(my $pass = $options{-password})) {
return $self->_parse($keytext, $pass, undef, undef);
} else {
return $self->_parse($keytext, undef, undef, undef);
}
}
=begin internals
=head2 _parse ($pemkey, $password, $engineobj, $use_engine_format)
The XS counterpart of L</parse>, sans the syntactic sugar. Parses a
PEM-encoded private key and returns an instance of
I<Crypt::OpenSSL::CA::PrivateKey> wrapping a OpenSSL C<EVP_PKEY *>
handle. All four arguments are mandatory. I<$engineobj> and
I<$use_engine_format> are B<UNIMPLEMENTED> and should both be passed
as undef.
=end internals
=cut
use Crypt::OpenSSL::CA::Inline::C <<"_PARSE";
/* Returns a password stored in memory. Callback invoked by
PEM_read_bio_PrivateKey() when parsing a password-protected
software private key */
static int gimme_password(char *buf, int bufsiz, int __unused_verify,
void *cb_data) {
int pwlength;
const char *password = (const char *) cb_data;
if (!password) { return -1; }
pwlength = strlen(password);
if (pwlength > bufsiz) { pwlength = bufsiz; }
memcpy(buf, password, pwlength);
return pwlength;
}
/* Ditto, but using the ui_method API. Callback invoked by
ENGINE_load_private_key when parsing an engine-based
private key */
/* UNIMPLEMENTED */
static
SV* _parse(char *class, const char* pemkey, SV* svpass,
SV* engine, SV* parse_using_engine_p) {
/* UNIMPLEMENTED: engine and parse_using_engine don't work */
BIO* keybio = NULL;
EVP_PKEY* pkey = NULL;
ENGINE* e;
char* pass = NULL;
if (SvOK(svpass)) { pass = char0_value(svpass); }
if (SvTRUE(parse_using_engine_p)) {
static UI_METHOD *ui_method = NULL;
croak("UNIMPLEMENTED, UNTESTED");
if (! (engine &&
(e = perl_unwrap("Crypt::OpenSSL::CA::ENGINE",
ENGINE*, engine)))) {
croak("no engine specified");
}
/* UNIMPLEMENTED: must parse from memory not file; must coerce
that wonky ui_method stuff into * passing C<pass> to the
engine */
/* pkey = (EVP_PKEY *)ENGINE_load_private_key
(e, file, ui_method, (void *) pass); */
} else {
keybio = BIO_new_mem_buf((void *) pemkey, -1);
if (keybio == NULL) {
croak("BIO_new failed");
}
pkey=PEM_read_bio_PrivateKey(keybio, NULL,
gimme_password, (void *) pass);
}
if (keybio != NULL) BIO_free(keybio);
if (pkey == NULL) {
sslcroak("unable to parse private key");
}
return perl_wrap("${\__PACKAGE__}", pkey);
}
_PARSE
=head2 get_public_key ()
Returns the public key associated with this
I<Crypt::OpenSSL::CA::PrivateKey> instance, as an
L</Crypt::OpenSSL::CA::PublicKey> object.
=cut
use Crypt::OpenSSL::CA::Inline::C <<"GET_PUBLIC_KEY";
#if OPENSSL_VERSION_NUMBER < 0x00908000
#define CONST_IF_D2I_PUBKEY_WANTS_ONE
#else
#define CONST_IF_D2I_PUBKEY_WANTS_ONE const
#endif
static
SV* get_public_key(SV* sv_self) {
EVP_PKEY* self = perl_unwrap("${\__PACKAGE__}", EVP_PKEY *, sv_self);
EVP_PKEY* retval = NULL;
unsigned char* asn1buf = NULL;
CONST_IF_D2I_PUBKEY_WANTS_ONE unsigned char* asn1buf_copy;
int size;
/* This calling idiom requires OpenSSL 0.9.7 */
size = i2d_PUBKEY(self, &asn1buf);
if (size < 0) { sslcroak("i2d_PUBKEY failed"); }
/* d2i_PUBKEY advances the pointer that is passed to it,
so we need to make a copy: */
asn1buf_copy = asn1buf;
d2i_PUBKEY(&retval, &asn1buf_copy, size);
OPENSSL_free(asn1buf);
if (! retval) {
sslcroak("d2i_PUBKEY failed");
}
return perl_wrap("Crypt::OpenSSL::CA::PublicKey", retval);
}
GET_PUBLIC_KEY
=begin OBSOLETE
lib/Crypt/OpenSSL/CA.pm view on Meta::CPAN
next;
}
$crlentries{uc($1)} = $2;
}
like($crlentries{"10"}, qr/Feb 12/, "revocation dates");
like($crlentries{"11"}, qr/unspecified/i) or do {
my $dumpasn1 = run_dumpasn1
(run_thru_openssl($crlpem, qw(crl -outform der)));
warn $dumpasn1;
};
like($crlentries{"12"}, qr/key.*compromise/i);
like($crlentries{"12"}, qr/Invalidity Date/i);
like($crlentries{"42DEADBEEF32"}, qr/hold/i)
or warn $crldump;
};
subtest "CRL memory leaks" => sub {
skip_all "Cannot check bytes leaks" if cannot_check_bytes_leaks;
leaks_bytes_ok {
for(1..100) {
my $crl = Crypt::OpenSSL::CA::X509_CRL->new();
for(1..200) { # Checks for robustness and leaks
christmasify_crl($crl);
}
for(1..20) { # Not too many entries, as that would cause
# false positives
add_entries_to_crl($crl);
}
$crl->sign($cakey, "sha1");
}
};
my $crlpem = $test_crls{"admin.ch"}->{pem};
leaks_bytes_ok {
for(1..2000) {
my $crl = Crypt::OpenSSL::CA::X509_CRL->parse($crlpem);
my @ignored = $crl->get_entries;
$crl->get_issuer_DN();
$crl->get_lastUpdate();
$crl->get_nextUpdate();
}
} -max => 131072; # There's quite a lot of churn going on in ->get_entries
leaks_SVs_ok {
for(1..100) {
my @ignored = Crypt::OpenSSL::CA::X509_CRL->parse($crlpem)->get_entries;
}
};
};
=head2 Synopsis test
We only check that it runs. Thorough black-box testing of
I<Crypt::OpenSSL::CA> happens in C<t/> instead.
=cut
subtest "synopsis" => sub {
my $synopsis = My::Tests::Below->pod_code_snippet("synopsis");
$synopsis = <<'PREAMBLE' . $synopsis;
my $pem_private_key = $test_keys_plaintext{rsa1024};
PREAMBLE
eval $synopsis; die $@ if $@;
pass;
};
=head2 Obsolete stuff
Yet still under test.
=cut
subtest "obsolete ::PrivateKey->get_RSA_modulus" => sub {
my $key = Crypt::OpenSSL::CA::PrivateKey
->parse($test_keys_plaintext{rsa1024});
is($key->get_RSA_modulus, $key->get_public_key->get_modulus);
};
subtest "obsolete ::X509->set_serial_hex" => sub {
my $cert = Crypt::OpenSSL::CA::X509->new
(Crypt::OpenSSL::CA::PublicKey
->parse_RSA($test_public_keys{rsa1024}));
$cert->set_serial_hex("abcd1234");
is($cert->get_serial, "0xabcd1234");
};
subtest "obsolete authorityKeyIdentifier_keyid extension" => sub {
my $pubkey = Crypt::OpenSSL::CA::PublicKey
->parse_RSA($test_public_keys{rsa1024});
my $privkey = Crypt::OpenSSL::CA::PrivateKey
->parse($test_keys_plaintext{rsa1024});
my $x509 = Crypt::OpenSSL::CA::X509->new($pubkey);
$x509->set_extension("authorityKeyIdentifier_keyid", "de:ad:be:ef");
$x509->sign($privkey, "sha1");
like($x509->dump, qr/de.ad.be.ef/i);
my $crl = Crypt::OpenSSL::CA::X509_CRL->new();
$crl->set_extension("authorityKeyIdentifier_keyid", "de:ad:be:ef");
$crl->sign($privkey, "sha1");
like($crl->dump, qr/de.ad.be.ef/i);
};
=head2 Symbol leakage test
Validates that no symbols are leaked at the .so interface boundary, as
documented in L</the static-newline trick>. This test must be kept
after all XS tests, as it needs all relevant .so modules loaded.
=cut
use DynaLoader;
subtest "symbol leak" => sub {
is(DynaLoader::dl_find_symbol_anywhere($_), undef,
"symbol $_ not visible")
for(qw(sslcroak new load parse to_string to_asn1 sign DESTROY));
};
done_testing;
( run in 2.058 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )