File Coverage

blib/lib/Crypt/OpenSSL/Cloner.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Crypt::OpenSSL::Cloner;
use strict;
use warnings;
use Crypt::OpenSSL::CA;
use Crypt::OpenSSL::RSA;
use File::Slurp qw(read_file write_file);
use File::Path qw(mkpath);
use Hash::Util qw(lock_keys);
use Data::Dumper;
use Time::HiRes;
use MIME::Base64 qw(decode_base64);
use Convert::ASN1;
#use Encoding::BER::DER;

use Crypt::OpenSSL::Cloner::x509asn1;

our $PREFERRED_ALG = "sha1";
our $PREFERRED_KEYLENGTH = 1024;
our $CA_BASENAME = "CA";
our $VERSION = 0.04;

my $ASN = Convert::ASN1->new();
$ASN->prepare($Crypt::OpenSSL::Cloner::x509asn1::ASN_DEF,
			  encoding => "DER") or die "GRRR";

my %PARSERS = map { $_, $ASN->find($_) } qw(
    SubjectKeyIdentifier
    BasicConstraints
    KeyUsage
    CertificatePolicies
    SubjectAltName
);

my %oid_2_ext = (
    '2.5.29.14' => "SubjectKeyIdentifier",
    '2.5.29.17' => "SubjectAltName",
    '2.5.29.37' => "KeyUsage",
    '2.5.29.32' => 'CertificatePolicies',
    '2.5.29.19' => "BasicConstraints",

);

my @FIELDS = qw(
    PATH
    CA_OBJ
    PRIVKEY_OBJ
    AUTH_KEY_ID
);

#To make sure we don't get a timestamp serial collision (unlikely but possible)
my %TS_SERIALS = ();

sub load_ca {
    my ($self) = @_;
    my $path = $self->{PATH};
    my ($privkey_obj,$privkey_string,$ca_obj,$pem);
    eval {
        $privkey_string = read_file($path . "/$CA_BASENAME.key");
        $pem = read_file($path."/$CA_BASENAME.pem");
    };
	return if $@;

    $privkey_obj = Crypt::OpenSSL::CA::PrivateKey->parse($privkey_string);
    $ca_obj = Crypt::OpenSSL::CA::X509->parse($pem);

    return unless ($privkey_obj && $ca_obj);
    return [$ca_obj,$privkey_obj];
}

sub _gen_new_ca {
    my ($self,$dn_hash) = @_;
    my $rsa = Crypt::OpenSSL::RSA->generate_key($PREFERRED_KEYLENGTH);
    my $privkey = Crypt::OpenSSL::CA::PrivateKey->parse(
        $rsa->get_private_key_string
    );
    my $ca = Crypt::OpenSSL::CA::X509->new($privkey->get_public_key);
    my $dn = Crypt::OpenSSL::CA::X509_NAME->new(%$dn_hash);
    my $keyid = $privkey->get_public_key->get_openssl_keyid();
	die "Need Distinguished Name for CA" if !$dn_hash;
    $ca->set_serial("0x1");
    $ca->set_notBefore("20080204101500Z");
    $ca->set_notAfter("20220204101500Z");
    $ca->set_subject_DN($dn);
    $ca->set_issuer_DN($dn);
    $ca->set_extension("subjectKeyIdentifier", $keyid);
    $ca->set_extension("authorityKeyIdentifier", {
        keyid => $keyid,
        issuer => $dn,
        serial => "0x1"
    });

    $ca->set_extension("basicConstraints", "CA:TRUE", -critical => 1);
    #$ca->set_extension("keyUsage" =>
    #                   "digitalSignature, nonRepudiation,".
    #                   "keyEncipherment, dataEncipherment, keyAgreement,".
    #                   "keyCertSign, cRLSign");
    my $crt_text = $ca->sign($privkey, $PREFERRED_ALG);
    return [$ca,$privkey,$crt_text,$rsa->get_private_key_string];
}

sub new {
    my ($cls,%opts) = @_;
    my $self = {};
    bless ($self, $cls);
    lock_keys(%$self, @FIELDS);
    my $path = delete $opts{path} or die "Must have CA path";
    my $dn_hash = delete $opts{dn};
    $dn_hash ||= {
        C => 'GB',
        O => 'CertOnTheFly',
        OU => "CertOnTheFly Certificate Generation",
        CN => 'CertOnTheFly Root'
    };

    mkpath($path);
    $self->{PATH} = $path;

    my ($ca_obj,$privkey_obj);
    my $res = $self->load_ca();
    if ($res) {
        ($ca_obj,$privkey_obj) = @$res;
    } else {
        my ($pem,$keytxt);
        ($ca_obj,$privkey_obj,$pem,$keytxt) = @{ $self->_gen_new_ca($dn_hash) };
        write_file($path . "/$CA_BASENAME.pem", $pem);
        write_file($path . "/$CA_BASENAME.key", $keytxt);
    }
    $self->{CA_OBJ} = $ca_obj;
    $self->{PRIVKEY_OBJ} = $privkey_obj;
    return $self;
}


sub clone_cert {
    my ($self,$pem,$domain_name) = @_;
    my $keystr = Crypt::OpenSSL::RSA->generate_key(1024)->get_private_key_string();
    my $privkey = Crypt::OpenSSL::CA::PrivateKey->parse($keystr);
    my $new_cert = Crypt::OpenSSL::CA::X509->new($privkey->get_public_key);

    my $alt_name_string = ($domain_name) ? "DNS:$domain_name" : "";

    $new_cert->set_subject_DN(Crypt::OpenSSL::CA::X509->parse($pem)->get_subject_DN);
    $new_cert->set_issuer_DN($self->{CA_OBJ}->get_issuer_DN);
    $new_cert->set_notBefore("20080204114600Z");
    $new_cert->set_notAfter("20220204114600Z");
    $new_cert->set_extension("authorityKeyIdentifier",
        { keyid => $self->{CA_OBJ}->get_subject_keyid });
    my $serial = time();
    $serial .= $TS_SERIALS{$serial}++;
    $serial = "0x$serial";
    $new_cert->set_serial($serial);
    my %extracted;
    my $blob = $pem;
    $blob =~ s/-----(BEGIN|END)\sCERTIFICATE-----//msg;
    $blob = decode_base64($blob);
    my $rootparse = $ASN->find("Certificate");
    my $extensions = $rootparse->decode($blob);
    $extensions = $extensions->{tbsCertificate}->{extensions};
    foreach my $ext (@$extensions) {
        my $oid = $ext->{extnID};
        my $extname = $oid_2_ext{$oid};
        next if !$extname;
        my $der = $ext->{extnValue};
        my $parser = $PARSERS{$extname};
        my $decoded = $parser->decode($der);
        if ($extname eq 'SubjectKeyIdentifier') {
            $new_cert->set_extension(
                "subjectKeyIdentifier", unpack('H*', $decoded));
        } elsif ($extname eq 'KeyUsage') {
            #Then try to figure that out, too..
            #Apparently this module has a different way of doing things...
            # Our sample cert doesn't seem to conform to this.. and using
            # A parse of another module, seems to be using OIDs for
            # ExtendedKeyUsage?
        } elsif ($extname eq 'SubjectAltName') {
            #ASN:
            #
            #GeneralName ::= CHOICE {
            #otherName                       [0]     AnotherName,
            #rfc822Name                      [1]     IA5String,
            #dNSName                         [2]     IA5String,
            #x400Address                     [3]     ANY, --ORAddress,
            #directoryName                   [4]     Name,
            #ediPartyName                    [5]     EDIPartyName,
            #uniformResourceIdentifier       [6]     IA5String,
            #iPAddress                       [7]     OCTET STRING,
            #registeredID                    [8]     OBJECT IDENTIFIER }

            my %asn2openssl = (
                otherName                   => "otherName",
                rfc822name                  => "email",
                dNSName                     => "DNS",
                x400Address                 => "dirName",
                #ediPartyName               => "what's this?",
                directoryName               => "dirName",
                uniformResourceIdentifier   => "URI",
                iPAddress                   => "IP",
                registeredID                => "RID",
            );
            my @altnames;
            my $altname = "";
            foreach my $h (@$decoded) {
                my ($k,$v) = (%$h);
                my $new_k = $asn2openssl{$k};
                if (!$new_k) {
                    warn "Found ASN.1 X509 field $k which doesn't have an OpenSSL mapping";
                    next;
                }
                $k = $new_k;
                push @altnames, "$k:$v";
            }
            $altname = join(",", @altnames);
            if ($alt_name_string) {
                $alt_name_string .= ",$altname";
            } else {
                $alt_name_string = $altname;
            }
        }
    }
    $new_cert->set_extension("subjectAltName", $alt_name_string) if $alt_name_string;
    my $new_pem = $new_cert->sign($self->{PRIVKEY_OBJ}, $PREFERRED_ALG);
    return ($new_pem, $keystr);
}

1;

__END__