Initial Commit

This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions

View File

@@ -0,0 +1,383 @@
package Crypt::DSA::GMP::Key;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::Key::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::Key::VERSION = '0.01';
}
use Carp qw( croak );
use Math::BigInt lib => "GMP";
use Crypt::DSA::GMP::Util qw( bitsize mod_exp );
use Math::Prime::Util::GMP qw/is_prime/;
sub new {
my ($class, %param) = @_;
my $key = bless { }, $class;
if ($param{Filename} || $param{Content}) {
if ($param{Filename} && $param{Content}) {
croak "Filename and Content are mutually exclusive.";
}
return $key->read(%param);
}
$key->{_validated} = 0;
$key;
}
sub size {
my $key = shift;
return bitsize($key->p);
}
sub sizes {
my $key = shift;
return ( bitsize($key->p), bitsize($key->q) );
}
BEGIN {
no strict 'refs'; ## no critic (ProhibitNoStrict)
for my $meth (qw( p q g pub_key priv_key )) {
# Values are stored as Math::BigInt objects
*$meth = sub {
my($key, $value) = @_;
if (defined $value) {
my $str;
if (ref($value) eq 'Math::BigInt') { $key->{$meth} = $value; }
elsif (ref($value) eq 'Math::Pari') { $str = Math::Pari::pari2pv($value); }
elsif (ref $value) { $str = "$value"; }
elsif ($value =~ /^0x/) { $key->{$meth} = Math::BigInt->new($value); }
else { $str = $value; }
$key->{$meth} = Math::BigInt->new("$str")
if defined $str && $str =~ /^\d+$/;
$key->{_validated} = 0;
} elsif (@_ > 1 && !defined $value) {
delete $key->{$meth};
$key->{_validated} = 0;
}
$key->{$meth};
};
}
}
# Basic mathematic validation of the key parameters.
sub validate {
my $key = shift;
return 0 unless defined $key;
return 1 if $key->{_validated};
my ($p, $q, $g, $x) = ($key->p, $key->q, $key->g, $key->priv_key);
return 0 unless defined $p && defined $q && defined $g;
return 0 unless is_prime($p) && is_prime($q);
return 0 unless ($p-1) % $q == 0;
return 0 unless 1 < $g && $g < $p;
return 0 unless mod_exp($g, $q, $p)->is_one;
if (defined $x) {
return 0 unless 0 < $x && $x < $q;
my $pub = mod_exp($g, $x, $p);
if (!defined $key->pub_key) {
$key->pub_key($pub);
} else {
return 0 unless $key->pub_key == $pub;
}
}
my $y = $key->pub_key;
return 0 unless defined $y;
return 0 unless $y < $p;
$key->{_validated} = 1;
1;
}
# Read and Write turn this base class key into a subclass of the
# appropriate type. However, how do we map their type string into
# the correct module?
# 1. eval "use $class;"
# Crypt::DSA does this. It is really not recommended.
# 2. Use Class::Load
# Correct dynamic way.
# 3. Hard code
# Avoids string evals, best security, but not dynamic.
sub read {
my ($key, %param) = @_;
my $type = $param{Type} or croak "read: Need a key file 'Type'";
$key->_subclass_key($type);
if (my $fname = delete $param{Filename}) {
open(my $fh, "<", $fname) or return;
my $blob = do { local $/; <$fh> };
close $fh or return;
$param{Content} = $blob;
}
$key->deserialize(%param);
}
sub write {
my ($key, %param) = @_;
croak "write: Cannot find public key"
unless defined $key && defined $key->pub_key;
my $type = $param{Type};
if (!defined $type) {
my $pkg = __PACKAGE__;
($type) = ref($key) =~ /^${pkg}::(\w+)$/;
}
croak "write: Need a key file 'Type'"
unless defined $type && $type ne '';
# Subclass key as the requested type.
$key->_subclass_key($type);
# Serialize using the subclass method
my $blob = $key->serialize(%param);
# Write to file if requested
if (my $fname = delete $param{Filename}) {
open(my $fh, ">", $fname) or croak "Can't open $fname: $!";
print $fh $blob;
close $fh or croak "Can't close $fname: $!";
}
# Return the serialized data
return $blob;
}
sub _subclass_key {
my ($key, $type) = @_;
croak "Key type undefined" unless defined $type;
if ($type eq 'PEM') {
require Crypt::DSA::GMP::Key::PEM;
bless $key, 'Crypt::DSA::GMP::Key::PEM';
} elsif ($type eq 'SSH2') {
require Crypt::DSA::GMP::Key::SSH2;
bless $key, 'Crypt::DSA::GMP::Key::SSH2';
} else {
croak "Invalid Key type: '$type'";
}
return $key;
}
1;
__END__
=pod
=for stopwords ssh-dss
=head1 NAME
Crypt::DSA::GMP::Key - DSA key
=head1 SYNOPSIS
use Crypt::DSA::GMP::Key;
my $key = Crypt::DSA::GMP::Key->new;
$key->p($p);
=head1 DESCRIPTION
L<Crypt::DSA::GMP::Key> contains a DSA key, both the public and
private portions. Subclasses of L<Crypt::DSA::GMP::Key> implement
I<read> and I<write> methods, such that you can store DSA
keys on disk, and read them back into your application.
=head1 USAGE
Any of the key attributes can be accessed through combination
get/set methods. The key attributes are: I<p>, I<q>, I<g>,
I<priv_key>, and I<pub_key>. For example:
$key->p($p);
my $p2 = $key->p;
All the attributes are L<Math::BigInt> objects. When setting
with a non-Math::BigInt object, we will attempt conversion from
native integers, numeric strings in base 10 or base 16 (the
latter with a C<0x> prefix), Pari objects, and any object that
support stringification to base 10.
=head2 $key = Crypt::DSA::GMP::Key->new(%arg)
Creates a new (empty) key object. All of the attributes are
initialized to 0.
Alternately, if you provide the I<Filename> parameter (see
below), the key will be read from disk. If you provide
the I<Type> parameter (mandatory if I<Filename> is provided),
be aware that your key will actually be blessed into a subclass
of L<Crypt::DSA::GMP::Key>. Specifically, it will be the class
implementing the specific read functionality for that type,
e.g. L<Crypt::DSA::GMP::Key::PEM>.
Returns the key on success, C<undef> otherwise. (See I<Password>
for one reason why I<new> might return C<undef>).
I<%arg> can contain:
=over 4
=item * Type
The type of file where the key is stored. Currently the only
types supported are I<PEM> and I<SSH2>.
A PEM file is an optionally encrypted, ASN.1-encoded object.
Support for reading/writing PEM files comes from L<Convert::PEM>.
If you don't have this module installed, the I<new> method will die.
An SSH2 file may either be a public key in I<ssh-dss> format, or
a private key using the SSH2 format.
This argument is mandatory, I<if> you're either reading the file from
disk (i.e. you provide a I<Filename> argument) or you've specified the
I<Content> argument.
=item * Filename
The location of the file which contains the key.
Requires a I<Type> argument so the decoder knows what type of file it
is. You can't specify I<Content> and I<Filename> at the same time.
=item * Content
The serialized version of the key. Requires a I<Type> argument so the
decoder knows how to decode it. You can't specify I<Content> and
I<Filename> at the same time.
=item * Password
If your key file is encrypted, you'll need to supply a
passphrase to decrypt it. You can do that here.
If your passphrase is incorrect, I<new> will return C<undef>.
=back
=head2 $key->write(%arg)
Writes a key (optionally) to disk, using a format that you
define with the I<Type> parameter.
If your I<$key> object has a defined I<priv_key> (private key portion),
the key will be written as a DSA private key object; otherwise, it will
be written out as a public key. Note that not all serialization mechanisms
can produce public keys in this version--currently, only PEM public keys
are supported.
I<%arg> can include:
=over 4
=item * Type
The type of file format that you wish to write, e.g. I<PEM>.
This argument is mandatory, I<unless> your I<$key> object is
already blessed into a subclass (e.g. L<Crypt::DSA::GMP::Key::PEM>),
and you wish to write the file using the same subclass.
=item * Filename
The location of the file on disk where you want the key file
to be written.
=item * Password
If you want the key file to be encrypted, provide this
argument, and the ASN.1-encoded string will be encrypted using
the passphrase as a key.
=back
=head2 $key->read(%arg)
Reads a key (optionally) from disk, using a format that you
define with the I<Type> parameter.
I<%arg> can include:
=over 4
=item * Type
The type of file format, e.g. I<PEM>, in which the key is stored.
This argument is mandatory.
=item * Filename
The location of the file on disk where the key file exists.
=item * Password
If the key file is encrypted, this argument must be provided.
=back
=head1 METHODS
=head2 size
Returns the size of the key in bits, which is the size of the
large prime I<p>.
=head2 sizes
Returns a two entry array (L, N) where L is the bit length of
I<p> and N is the bit length of I<q>.
=head2 validate
Does simple validation on the key and returns 1 if it passes,
and 0 otherwise. This includes:
=over 4
=item * existence check on I<p>, I<q>, and I<g>
=item * verify primality of I<p> and I<q>
=item * verify I<q> is a factor of I<p-1>
=item * partial validation of I<g> (FIPS 186-4 A.2.2)
=item * existence check of one of I<priv_key> or I<pub_key>
=item * construction or verification of I<pub_key> if I<priv_key> exists
=back
Using the high level L<Crypt::DSA:::GMP> routines, this method
is called after key generation, before signing, and before
verification. An exception is thrown if the result is not
valid.
=head2 p
The prime modulus I<p>, with bit length L.
=head2 q
A prime divisor of I<p-1>, with bit length N.
=head2 g
A generator of a subgroup of order I<q> in the multiplicative group
of C<GF(p)>. I<g> is in the range [I<2>,I<p-1>].
=head2 priv_key
The private key that must remain secret. It is a randomly
generated integer in the range [I<1>,I<q-1>].
=head2 pub_key
The public key, where I<pub_key> = I<g> ^ I<priv_key> mod I<p>.
=head1 AUTHOR & COPYRIGHTS
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut

View File

@@ -0,0 +1,192 @@
package Crypt::DSA::GMP::Key::PEM;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::Key::PEM::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::Key::PEM::VERSION = '0.01';
}
use base qw( Crypt::DSA::GMP::Key );
use Carp qw( croak );
use Convert::PEM 0.07; # So encode honors the Name parameter
use Crypt::DSA::GMP::Key;
sub deserialize {
my $key = shift;
my %param = @_;
$param{Content} =~ /DSA PRIVATE KEY/ ?
$key->_deserialize_privkey(%param) :
$key->_deserialize_pubkey(%param);
}
sub _deserialize_privkey {
my $key = shift;
my %param = @_;
my $pem = $key->_pem;
my $pkey = $pem->decode( Content => $param{Content},
Password => $param{Password},
Macro => 'DSAPrivateKey' );
return unless $pkey;
for my $m (qw( p q g pub_key priv_key )) {
$key->$m( $pkey->{$m} );
}
$key;
}
sub _deserialize_pubkey {
my $key = shift;
my %param = @_;
my $pem = $key->_pem;
my $pkey = $pem->decode( Content => $param{Content},
Password => $param{Password},
Macro => 'DSAPublicKey',
Name => 'PUBLIC KEY' );
return unless $pkey;
my $asn = $pem->asn->find('DSAPubKeyInner');
my $num = $asn->decode($pkey->{pub_key}[0]) or croak $asn->{error};
for my $m (qw( p q g )) {
$key->$m( $pkey->{inner}{DSAParams}{$m} );
}
$key->pub_key($num);
$key;
}
sub serialize {
my $key = shift;
## If this is a private key (has the private key portion), serialize
## it as a private key; otherwise use a public key ASN.1 object.
$key->priv_key ? $key->_serialize_privkey(@_) : $key->_serialize_pubkey(@_);
}
sub _serialize_privkey {
my $key = shift;
my %param = @_;
my $pkey = { version => 0 };
for my $m (qw( p q g pub_key priv_key )) {
$pkey->{$m} = $key->$m();
}
my $pem = $key->_pem;
my $buf = $pem->encode(
Content => $pkey,
Password => $param{Password},
Name => 'DSA PRIVATE KEY',
Macro => 'DSAPrivateKey',
) or croak $pem->errstr;
$buf;
}
sub _serialize_pubkey {
my $key = shift;
my %param = @_;
my $pem = $key->_pem;
my $asn = $pem->asn->find('DSAPubKeyInner');
## Force stringification.
my $str = $asn->encode($key->pub_key . '') or croak $asn->{error};
my $pkey = {
inner => {
objId => '1.2.840.10040.4.1',
DSAParams => {
p => $key->p,
q => $key->q,
g => $key->g
},
},
pub_key => $str
};
my $buf = $pem->encode(
Content => $pkey,
Password => $param{Password},
Name => 'PUBLIC KEY',
Macro => 'DSAPublicKey',
) or return $key->error($pem->errstr);
$buf;
}
sub _pem {
my $key = shift;
unless (defined $key->{__pem}) {
my $pem = Convert::PEM->new(
Name => "DSA PRIVATE KEY",
ASN => qq(
DSAPrivateKey ::= SEQUENCE {
version INTEGER,
p INTEGER,
q INTEGER,
g INTEGER,
pub_key INTEGER,
priv_key INTEGER
}
DSAPublicKey ::= SEQUENCE {
inner SEQUENCE {
objId OBJECT IDENTIFIER,
DSAParams SEQUENCE {
p INTEGER,
q INTEGER,
g INTEGER
}
}
pub_key BIT STRING
}
DSAPubKeyInner ::= INTEGER
));
$key->{__pem} = $pem;
}
$key->{__pem};
}
1;
__END__
=pod
=head1 NAME
Crypt::DSA::GMP::Key::PEM - Read/write DSA PEM files
=head1 SYNOPSIS
use Crypt::DSA::GMP::Key;
my $key = Crypt::DSA::GMP::Key->new( Type => 'PEM', ...);
$key->write( Type => 'PEM', ...);
=head1 DESCRIPTION
L<Crypt::DSA::GMP::Key::PEM> provides an interface for reading
and writing DSA PEM files, using L<Convert::PEM>. The files are
ASN.1-encoded and optionally encrypted.
You shouldn't use this module directly. As the SYNOPSIS above
suggests, this module should be considered a plugin for
L<Crypt::DSA::GMP::Key>, and all access to PEM files (reading DSA
keys from disk, etc.) should be done through that module.
Read the L<Crypt::DSA::GMP::Key> documentation for more details.
=head1 SUBCLASS METHODS
=head2 serialize
Returns the appropriate serialization blob of the key.
=head2 deserialize
Given an argument hash containing I<Content> and I<Password>, this
unpacks the serialized key into the self object.
=head1 AUTHOR & COPYRIGHTS
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut

View File

@@ -0,0 +1,168 @@
package Crypt::DSA::GMP::Key::SSH2;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::Key::SSH2::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::Key::SSH2::VERSION = '0.01';
}
use base qw( Crypt::DSA::GMP::Key );
use MIME::Base64 qw( decode_base64 );
use Crypt::DSA::GMP::Key;
sub deserialize {
my $key = shift;
my %param = @_;
chomp($param{Content});
my $base64;
if ($param{Content} =~ m:ssh-dss (.+)\s+\S+\s*$:s) {
$base64 = $1;
} elsif ($param{Content} =~ /---- BEGIN/) {
my($head, $object, $content, $tail) = $param{Content} =~
m:(---- BEGIN ([^\n\-]+) ----)\n(.+)(---- END .*? ----)$:s;
my @lines = split /\n/, $content;
my $escaped = 0;
my @real;
for my $l (@lines) {
if (substr($l, -1) eq '\\') {
$escaped++;
next;
}
next if index($l, ':') != -1;
if ($escaped) {
$escaped--;
next;
}
push @real, $l;
}
$base64 = join "\n", @real;
}
return unless defined $base64;
my $content = decode_base64($base64);
my $b = BufferWithInt->new_with_init($content);
if ($b->get_int32 == 7 && $b->get_bytes(7) eq 'ssh-dss') {
# This is the public key format created by OpenSSH
$key->p( $b->get_mp_ssh2b );
$key->q( $b->get_mp_ssh2b );
$key->g( $b->get_mp_ssh2b );
$key->pub_key( $b->get_mp_ssh2b );
$key->priv_key(undef);
return $key;
}
$b->reset_offset;
# This all follows ssh-keygen.c: do_convert_private_ssh2_from_blob
my $magic = $b->get_int32;
return unless $magic == 0x3f6ff9eb; # Private Key MAGIC
my($ignore);
$ignore = $b->get_int32;
my $type = $b->get_str;
my $cipher = $b->get_str;
$ignore = $b->get_int32 for 1..3;
return unless $cipher eq 'none';
$key->p( $b->get_mp_ssh2 );
$key->g( $b->get_mp_ssh2 );
$key->q( $b->get_mp_ssh2 );
$key->pub_key( $b->get_mp_ssh2 );
$key->priv_key( $b->get_mp_ssh2 );
#return unless $b->length == $b->offset;
$key;
}
sub serialize {
my $key = shift;
my %param = @_;
die "serialize is unimplemented";
}
package BufferWithInt;
use strict;
use Data::Buffer;
use Crypt::DSA::GMP::Util qw( bin2mp );
use base qw( Data::Buffer );
sub get_mp_ssh2 {
my $buf = shift;
my $bits = $buf->get_int32;
my $off = $buf->{offset};
my $bytes = int(($bits+7) / 8);
my $int = bin2mp( $buf->bytes($off, $bytes) );
$buf->{offset} += $bytes;
$int;
}
sub get_mp_ssh2b {
my $buf = shift;
my $bytes = $buf->get_int32;
my $off = $buf->{offset};
my $int = bin2mp( $buf->bytes($off, $bytes) );
$buf->{offset} += $bytes;
$int;
}
1;
__END__
=head1 NAME
Crypt::DSA::GMP::Key::SSH2 - Read/write DSA SSH2 files
=head1 SYNOPSIS
use Crypt::DSA::GMP::Key;
my $key = Crypt::DSA::GMP::Key->new( Type => 'SSH2', ...);
$key->write( Type => 'SSH2', ...);
=head1 DESCRIPTION
L<Crypt::DSA::GMP::Key::SSH2> provides an interface for reading
and writing DSA SSH2 files, using L<Data::Buffer>, which provides
functionality for SSH-compatible binary in/out buffers.
Currently encrypted key files are not supported.
You shouldn't use this module directly. As the SYNOPSIS above
suggests, this module should be considered a plugin for
L<Crypt::DSA::GMP::Key>, and all access to SSH2 files (reading DSA
keys from disk, etc.) should be done through that module.
Read the L<Crypt::DSA::GMP::Key> documentation for more details.
=head1 SUBCLASS METHODS
=head2 serialize
Returns the appropriate serialization blob of the key.
=head2 deserialize
Given an argument hash containing I<Content> and I<Password>, this
unpacks the serialized key into the self object.
=head1 TODO
This doesn't handle data produced by OpenSSH. To see the data
from a DSA key in their format:
cat file.dsa | grep -v -- ----- | tr -d '\n' | base64 -d | \
openssl asn1parse -inform DER
So we will need Convert::ASN1 to handle this.
=head1 AUTHOR & COPYRIGHTS
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut

View File

@@ -0,0 +1,395 @@
package Crypt::DSA::GMP::KeyChain;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::KeyChain::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::KeyChain::VERSION = '0.01';
}
use Carp qw( croak );
use Math::BigInt lib => "GMP";
use Math::Prime::Util::GMP qw/is_prob_prime is_provable_prime miller_rabin_random/;
use Digest::SHA qw( sha1 sha1_hex sha256_hex);
use Crypt::DSA::GMP::Key;
use Crypt::DSA::GMP::Util qw( bin2mp bitsize mod_exp makerandomrange randombytes );
sub new {
my ($class, @params) = @_;
return bless { @params }, $class;
}
sub generate_params {
my ($keygen, %param) = @_;
croak "Size parameter missing" unless defined $param{Size};
my $bits = int($param{Size});
my $v = $param{Verbosity};
my $proveq = $param{Prove} && $param{Prove} !~ /^p$/i;
my $provep = $param{Prove} && $param{Prove} !~ /^q$/i;
croak "Number of bits (Size => $bits) is too small (min 256)"
unless $bits >= 256;
# TODO:
# - strict FIPS 186-2 compliance requires L to be a multiple
# of 64 512 <= L <= 1024.
# - strict FIPS 186-3/4 compliance requires L,N to be one of
# the pairs: (1024,160) (2048,224) (2048,256) (3072,256)
# - Can we use new generation method if seed is null?
# OpenSSL was removed:
# 1. It was a portability issue (7 RTs related to it).
# 2. It removes module dependencies.
# 2. Security issues with running a program in the path without
# verifying it is the correct executable.
# 3. We know the code here follows FIPS 186-4. OpenSSL does not.
# 4. The behavior of OpenSSL has changed across different versions.
# 5. This code is faster for key sizes larger than 1024 bits.
# Time for key generations (without proofs, average of 1000)
# 512-bit 47ms Perl 25ms OpenSSL
# 768-bit 78ms Perl 69ms OpenSSL
# 1024-bit 139ms Perl 144ms OpenSSL
# 2048-bit 783ms Perl 1,144ms OpenSSL
# 4096-bit 7,269ms Perl 12,888ms OpenSSL
$param{Standard} = $keygen->{Standard}
if defined $keygen->{Standard} && !defined $param{Standard};
my $standard = (defined $param{Standard} && $param{Standard} =~ /186-[34]/)
? 'FIPS 186-4'
: 'FIPS 186-2';
# $mrseed is just a random number we give to the primality test to give us
# a unique sequence of bases. It's not that important other than (1) we
# don't want the same sequence each call, (2) we don't want to leak any
# information about our state, and (3) we don't want to spend too much
# time/entropy on it. A truncated hash of our seed should work well.
my($counter, $q, $p, $seed, $seedp1, $mrseed);
if ($standard eq 'FIPS 186-2') {
croak "FIPS 186-2 does not support Q sizes other than 160"
if defined $param{QSize} && $param{QSize} != 160;
# See FIPS 186-4 A.1.1.1, non-approved method.
delete $param{Seed} if defined $param{Seed} && length($param{Seed}) != 20;
my $n = int(($bits+159)/160)-1;
my $b = $bits-1-($n*160);
my $p_test = Math::BigInt->new(2)->bpow($bits-1); # 2^(L-1)
do {
## Generate q
while (1) {
print STDERR "." if $v;
$seed = (defined $param{Seed}) ? delete $param{Seed}
: randombytes(20);
$seedp1 = _seed_plus_one($seed);
my $md = sha1($seed) ^ sha1($seedp1);
vec($md, 0, 8) |= 0x80;
vec($md, 19, 8) |= 0x01;
$q = bin2mp($md);
$mrseed = '0x'.substr(sha256_hex($seed),0,16) unless defined $mrseed;
last if ( $proveq && is_provable_prime($q))
|| (!$proveq && is_prob_prime($q)
&& miller_rabin_random($q, 19, $mrseed));
}
print STDERR "*\n" if $v;
## Generate p.
$counter = 0;
my $q2 = Math::BigInt->new(2)->bmul($q);
while ($counter < 4096) {
print STDERR "." if $v;
my $Wstr = '';
for my $j (0 .. $n) {
$seedp1 = _seed_plus_one($seedp1);
$Wstr = sha1_hex($seedp1) . $Wstr;
}
my $W = Math::BigInt->from_hex('0x'.$Wstr)->bmod($p_test);
my $X = $W + $p_test;
$p = $X - ( ($X % $q2) - 1);
if ($p >= $p_test) {
last if ( $provep && is_provable_prime($p))
|| (!$provep && is_prob_prime($p)
&& miller_rabin_random($p, 3, $mrseed));
}
$counter++;
}
} while ($counter >= 4096);
# /\ /\ /\ /\ FIPS 186-2 /\ /\ /\ /\ #
} else {
# \/ \/ \/ \/ FIPS 186-4 \/ \/ \/ \/ #
my $L = $bits;
my $N = (defined $param{QSize}) ? $param{QSize}
: ($bits >= 2048) ? 256 : 160;
croak "Invalid Q size, must be between 1 and 512" if $N < 1 || $N > 512;
croak "Invalid Q size, must be >= Size+8" if $L < $N+8;
# See NIST SP 800-57 rev 3, table 3. sha256 is ok for all sizes
my $outlen = ($N <= 256) ? 256 : ($N <= 384) ? 384 : 512;
my $sha = Digest::SHA->new($outlen);
croak "No digest available for Q size $N" unless defined $sha;
my $n = int(($L+$outlen-1)/$outlen)-1;
my $b = $L-1-($n*$outlen);
my $p_test = Math::BigInt->new(2)->bpow($L-1); # 2^(L-1)
my $q_test = Math::BigInt->new(2)->bpow($N-1); # 2^(N-1)
my $seedlen = int( ($N+7)/8 );
my $nptests = ($L <= 2048) ? 3 : 2; # See FIPS 186-4 table C.1
my $nqtests = ($N <= 160) ? 19 : 27;
delete $param{Seed}
if defined $param{Seed} && length($param{Seed}) < $seedlen;
$param{Seed} = substr($param{Seed}, 0, $seedlen) if defined $param{Seed};
do {
## Generate q
while (1) {
print STDERR "." if $v;
$seed = (defined $param{Seed}) ? delete $param{Seed}
: randombytes($seedlen);
my $digest = $sha->reset->add($seed)->hexdigest;
my $U = Math::BigInt->from_hex('0x'.$digest)->bmod($q_test);
$q = $q_test + $U + 1 - $U->is_odd();
$mrseed = '0x'.substr(sha256_hex($seed),0,16) unless defined $mrseed;
last if ( $proveq && is_provable_prime($q))
|| (!$proveq && is_prob_prime($q)
&& miller_rabin_random($q, $nqtests, $mrseed));
}
print STDERR "*\n" if $v;
$seedp1 = $seed;
## Generate p.
$counter = 0;
my $q2 = Math::BigInt->new(2)->bmul($q);
while ($counter < 4*$L) {
print STDERR "." if $v;
my $Wstr = '';
for my $j (0 .. $n) {
$seedp1 = _seed_plus_one($seedp1);
$Wstr = $sha->reset->add($seedp1)->hexdigest . $Wstr;
}
my $W = Math::BigInt->from_hex('0x'.$Wstr)->bmod($p_test);
my $X = $W + $p_test;
$p = $X - ( ($X % $q2) - 1);
if ($p >= $p_test) {
last if ( $provep && is_provable_prime($p))
|| (!$provep && is_prob_prime($p)
&& miller_rabin_random($p, $nptests, $mrseed));
}
$counter++;
}
} while ($counter >= 4*$L);
}
print STDERR "*" if $v;
my $e = ($p - 1) / $q;
my $h = Math::BigInt->bone;
my $g;
do {
$g = mod_exp(++$h, $e, $p);
} while $g == 1;
print STDERR "\n" if $v;
my $key = Crypt::DSA::GMP::Key->new;
$key->p($p);
$key->q($q);
$key->g($g);
return wantarray ? ($key, $counter, "$h", $seed) : $key;
}
# Using FIPS 186-4 B.1.2 approved method.
sub generate_keys {
my ($keygen, $key, $nonblock) = @_;
my $q = $key->q;
# Generate private key 0 < x < q, using best randomness source.
my $priv_key = makerandomrange( Max => $q-2, KeyGen => !$nonblock ) + 1;
my $pub_key = mod_exp($key->g, $priv_key, $key->p);
$key->priv_key($priv_key);
$key->pub_key($pub_key);
}
sub _seed_plus_one {
my($s) = @_;
for (my $i = length($s)-1; $i >= 0; $i--) {
vec($s, $i, 8)++;
last unless vec($s, $i, 8) == 0;
}
return $s;
}
1;
=pod
=head1 NAME
Crypt::DSA::GMP::KeyChain - DSA key generation system
=head1 SYNOPSIS
use Crypt::DSA::GMP::KeyChain;
my $keychain = Crypt::DSA::GMP::KeyChain->new;
my $key = $keychain->generate_params(
Size => 512,
Seed => $seed,
Verbosity => 1,
);
$keychain->generate_keys($key);
=head1 DESCRIPTION
L<Crypt::DSA::GMP::KeyChain> is a lower-level interface to key
generation than the L<Crypt::DSA::GMP/keygen> method.
It allows you to separately generate the I<p>, I<q>,
and I<g> key parameters, given an optional starting seed, bit
sizes for I<p> and I<q>, and which standard to follow for
construction.
You can then call I<generate_keys> to generate the public and
private portions of the key.
=head1 USAGE
=head2 $keychain = Crypt::DSA::GMP::KeyChain->new
Constructs and returns a new L<Crypt::DSA::GMP::KeyChain>
object. At the moment this isn't particularly useful in
itself, other than being the object you need in order to
call the other methods.
The standard to follow may be given in this call, where it
will be used in all methods unless overridden.
=head2 $key = $keychain->generate_params(%arg)
Generates a set of DSA parameters: the I<p>, I<q>, and I<g>
values of the key. This involves finding primes, and as such
it can be a relatively long process.
When invoked in scalar context, returns a new
I<Crypt::DSA::GMP::Key> object.
In list context, returns the new I<Crypt::DSA::GMP::Key> object
along with: the value of the internal counter when a suitable
prime I<p> was found; the value of I<h> when I<g> was derived;
and the value of the seed (a 20-byte or 32-byte string) when
I<q> was found. These values aren't particularly useful in normal
circumstances, but they could be useful.
I<%arg> can contain:
=over 4
=item * Standard
Indicates which standard is to be followed. By default,
FIPS 186-2 is used, which maintains backward compatibility
with the L<Crypt::DSA> Perl code and old OpenSSL versions. If
C<FIPS 186-3> or C<FIPS 186-4> is given, then the FIPS 186-4
key generation will be used.
The important changes made:
- Using SHA-2 rather than SHA-1 for the CSPRNG. This produces
better quality random data for prime generation.
- Allows I<N> to vary between 1 and 512 rather than fixed at 160.
- The default size for I<N> when not specified is 256 if I<L> is
2048 or larger, 160 otherwise.
- In L<Crypt::DSA::GMP>, the signing and verification will use
SHA-2 256 for signing and verification when I<N> E<lt>= 256,
and SHA-2 512 otherwise. The old standard used SHA-1.
where I<N> is the bit size of I<q>, and I<L> is the bit size of I<p>.
These correspond to the I<QSize> and I<Size> arguments.
The recommended primality tests from FIPS 186-4 are always
performed, since they are more stringent than the older standard
and have no negative impact on the result.
=item * Size
The size in bits of the I<p> value to generate. The minimum
allowable value is 256, and must also be at least 8 bits larger
than the size of I<q> (defaults to 160, see I<QSize>).
For any use where security is a concern, 1024 bits should be
considered a minimum size. NIST SP800-57 (July 2012) considers
1024 bit DSA using SHA-1 to be deprecated, with 2048 or more bits
using SHA-2 to be acceptable.
This argument is mandatory.
=item * QSize
The size in bits of the I<q> value to generate. For the default
FIPS 186-2 standard, this must always be 160. If the FIPS 186-4
standard is used, then this may be in the range 1 to 512 (values
less than 160 are strongly discouraged).
If not specified, I<q> will be 160 bits if either the default
FIPS 186-2 standard is used or if I<Size> is less than 2048.
If FIPS 186-4 is used and I<Size> is 2048 or larger, then I<q>
will be 256.
=item * Seed
A seed with which I<q> generation will begin. If this seed does
not lead to a suitable prime, it will be discarded, and a new
random seed chosen in its place, until a suitable prime can be
found.
A seed that is shorter than the size of I<q> will be
immediately discarded.
This is entirely optional, and if not provided a random seed will
be generated automatically. Do not use this option unless you
have a specific need for a starting seed.
=item * Verbosity
Should be either 0 or 1. A value of 1 will give you a progress
meter during I<p> and I<q> generation -- this can be useful, since
the process can be relatively long.
The default is 0.
=item * Prove
Should be 0, 1, I<P>, or I<Q>. If defined and true, then both
the primes for I<p> and I<q> will be proven primes. Setting to
the string I<P> or I<Q> will result in just that prime being proven.
Using this flag will guarantee the values are prime, which is
valuable if security is extremely important. The current
implementation constructs random primes using the method
A.1.1.1, then ensures they are prime by constructing and
verifying a primality proof, rather than using a constructive
method such as the Maurer or Shawe-Taylor algorithms. The
time for proof will depend on the platform and the Size
parameter. Proving I<q> should take 100 milliseconds or
less, but I<p> can take a very long time if over 1024 bits.
The default is 0, which means the standard FIPS 186-4 probable
prime tests are done.
=back
=head2 $keychain->generate_keys($key)
Generates the public and private portions of the key I<$key>,
a I<Crypt::DSA::GMP::Key> object.
=head1 AUTHOR & COPYRIGHT
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut

View File

@@ -0,0 +1,151 @@
package Crypt::DSA::GMP::Signature;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::Signature::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::Signature::VERSION = '0.01';
}
use Carp qw( croak );
sub new {
my ($class, %param) = @_;
my $sig = bless { }, $class;
if ($param{Content}) {
return $sig->deserialize(%param);
}
return $sig;
}
BEGIN {
no strict 'refs'; ## no critic (ProhibitNoStrict)
for my $meth (qw( r s )) {
# Values are stored as Math::BigInt objects
*$meth = sub {
my($key, $value) = @_;
if (defined $value) {
my $str;
if (ref($value) eq 'Math::BigInt') { $key->{$meth} = $value; }
elsif (ref($value) eq 'Math::Pari') { $str = Math::Pari::pari2pv($value); }
elsif (ref $value) { $str = "$value"; }
elsif ($value =~ /^0x/) { $key->{$meth} = Math::BigInt->new($value); }
else { $str = $value; }
$key->{$meth} = Math::BigInt->new("$str")
if defined $str && $str =~ /^\d+$/;
} elsif (@_ > 1 && !defined $value) {
delete $key->{$meth};
}
$key->{$meth};
};
}
}
sub _asn {
require Convert::ASN1;
my $asn = Convert::ASN1->new;
$asn->prepare('SEQUENCE { r INTEGER, s INTEGER }') or croak $asn->{error};
$asn;
}
sub deserialize {
my ($sig, %param) = @_;
my $asn = __PACKAGE__->_asn;
my $ref = $asn->decode($param{Content});
if (!$ref) {
require MIME::Base64;
my $base64_content = do {
no warnings;
MIME::Base64::decode_base64($param{Content});
};
$ref = $asn->decode($base64_content);
}
croak "Invalid Content" unless $ref;
$sig->s($ref->{s});
$sig->r($ref->{r});
$sig;
}
sub serialize {
my ($sig, %param) = @_;
my $asn = __PACKAGE__->_asn;
my $buf = $asn->encode({ s => $sig->s, r => $sig->r })
or croak $asn->{error};
$buf;
}
1;
__END__
=for stopwords deserialize
=head1 NAME
Crypt::DSA::GMP::Signature - DSA signature object
=head1 SYNOPSIS
use Crypt::DSA::GMP::Signature;
my $sig = Crypt::DSA::GMP::Signature->new;
$sig->r($r);
$sig->s($s);
=head1 DESCRIPTION
L<Crypt::DSA::GMP::Signature> represents a DSA signature. It has two
methods, L</r> and L</s>, which are the L<Math::BigInt> representations
of the two pieces of the DSA signature.
=head1 USAGE
=head2 Crypt::DSA::GMP::Signature->new( %options )
Creates a new signature object, and optionally initializes it with the
information in I<%options>, which can contain:
=over 4
=item * Content
An ASN.1-encoded string representing the DSA signature. In ASN.1 notation,
this looks like:
SEQUENCE {
r INTEGER,
s INTEGER
}
If I<Content> is provided, I<new> will automatically call the L</deserialize>
method to parse the content, and set the L</r> and L</s> methods on the
resulting L<Crypt::DSA::GMP::Signature> object.
=back
=head1 METHODS
=head2 serialize
Serializes the signature object I<$sig> into the format described above:
an ASN.1-encoded representation of the signature, using the ASN.1 syntax
above.
=head2 deserialize
Deserializes the ASN.1-encoded representation into a signature object.
=head2 r
One half of the DSA signature for a message.
This is a L<Math::BigInt> object.
=head2 s
One half of the DSA signature for a message.
This is a L<Math::BigInt> object.
=head1 AUTHOR & COPYRIGHTS
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut

View File

@@ -0,0 +1,187 @@
package Crypt::DSA::GMP::Util;
use strict;
use warnings;
BEGIN {
$Crypt::DSA::GMP::Util::AUTHORITY = 'cpan:DANAJ';
$Crypt::DSA::GMP::Util::VERSION = '0.01';
}
use Carp qw( croak );
use Math::BigInt lib => "GMP";
use Crypt::Random::Seed;
use base qw( Exporter );
our @EXPORT_OK = qw( bitsize bin2mp mp2bin mod_inverse mod_exp randombytes makerandom makerandomrange );
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
sub bitsize {
my $n = shift;
$n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt';
length($n->as_bin) - 2;
}
# This is the os2ip function
sub bin2mp {
my $s = shift;
return Math::BigInt->new(0) if !defined $s || $s eq '';
return Math::BigInt->from_hex('0x' . unpack("H*", $s));
}
# This is the i2osp function
sub mp2bin {
my $p = shift;
my $res = '';
if (ref($p) ne 'Math::BigInt' && $p <= ~0) {
do {
$res = chr($p & 0xFF) . $res;
$p >>= 8;
} while $p;
} else {
$p = Math::BigInt->new("$p") unless ref($p) eq 'Math::BigInt';
my $hex = $p->as_hex;
$hex =~ s/^0x0*//;
substr($hex, 0, 0, '0') if length($hex) % 2;
$res = pack("H*", $hex);
}
$res;
}
sub mod_exp {
my($a, $exp, $n) = @_;
$a->copy->bmodpow($exp, $n);
}
sub mod_inverse {
my($a, $n) = @_;
$a->copy->bmodinv($n);
}
{
my ($crs, $crs_best);
sub _setup_rng {
$crs_best = Crypt::Random::Seed->new();
$crs = ($crs_best->is_blocking())
? Crypt::Random::Seed->new(NonBlocking=>1)
: $crs_best;
}
sub randombytes {
my($bytes, $keygen) = @_;
_setup_rng() unless defined $crs;
my $src = ($keygen) ? $crs_best : $crs;
return $src->random_bytes($bytes);
}
}
# Generate uniform random number in range [2^(bits-1),2^bits-1]
sub makerandom {
my %param = @_;
my ($bits, $is_keygen) = ( $param{Size}, $param{KeyGen} );
croak "makerandom must have Size >= 1" unless defined $bits && $bits > 0;
return Math::BigInt->bone if $bits == 1;
my $randbits = $bits - 1;
my $randbytes = int(($randbits+7)/8);
my $randbinary = unpack("B*", randombytes( $randbytes, $is_keygen ));
return Math::BigInt->from_bin( '0b1' . substr($randbinary,0,$randbits) );
}
# Generate uniform random number in range [0, $max]
sub makerandomrange {
my %param = @_;
my ($max, $is_keygen) = ( $param{Max}, $param{KeyGen} );
croak "makerandomrange must have a Max > 0" unless defined $max && $max > 0;
$max = Math::BigInt->new("$max") unless ref($max) eq 'Math::BigInt';
my $range = $max->copy->binc;
my $bits = length($range->as_bin) - 2;
my $bytes = 1 + int(($bits+7)/8);
my $rmax = Math::BigInt->bone->blsft(8*$bytes)->bdec();
my $overflow = $rmax - ($rmax % $range);
my $U;
do {
$U = Math::BigInt->from_hex( '0x' . unpack("H*", randombytes($bytes,$is_keygen)) );
} while $U >= $overflow;
$U->bmod($range); # U is randomly in [0, k*$range-1] for some k.
return $U;
}
1;
__END__
=pod
=for stopwords mod_exp($a makerandom makerandomrange
=head1 NAME
Crypt::DSA::GMP::Util - DSA Utility functions
=head1 SYNOPSIS
use Crypt::DSA::GMP::Util qw( func1 func2 ... );
=head1 DESCRIPTION
L<Crypt::DSA::GMP::Util> contains a set of exportable utility functions
used through the L<Crypt::DSA::GMP> module.
=head2 bitsize($n)
Returns the number of bits in the integer I<$n>.
=head2 bin2mp($string)
Given a string I<$string> of any length, treats the string as a
base-256 representation of an integer, and returns that integer.
=head2 mp2bin($int)
Given an integer I<$int> (maybe a L<Math::BigInt> object),
returns an octet string representation (e.g. a string where
each byte is a base-256 digit of the integer).
=head2 mod_exp($a, $exp, $n)
Computes $a ^ $exp mod $n and returns the value.
=head2 mod_inverse($a, $n)
Computes the multiplicative inverse of $a mod $n and returns the
value.
=head2 randombytes($n)
Returns I<$n> random bytes from the entropy source. The entropy
source is a L<Crypt::Random::Seed> source.
An optional boolean second argument indicates whether the data
is being used for key generation, hence the best possible
randomness is used. If this argument is not present or is false,
then the best non-blocking source will be used.
=head2 makerandom
$n = makerandom(Size => 512);
Takes a I<Size> argument and creates a random L<Math::BigInt>
with exactly that number of bits using data from L</randombytes>.
The high order bit will always be set.
Also takes an optional I<KeyGen> argument that is given to
L</randombytes>.
=head2 makerandomrange
$n = makerandomrange(Max => $max); # 0 <= $n <= $max
Returns a L<Math::BigInt> uniformly randomly selected between
I<0> and I<$max>. Random data is provided by L</randombytes>.
Also takes an optional I<KeyGen> argument that is given to
L</randombytes>.
=head1 AUTHOR & COPYRIGHTS
See L<Crypt::DSA::GMP> for author, copyright, and license information.
=cut