use strict;
use warnings;
use Test::More;
# PoC: biased DSA nonce k in Crypt::DSA (<= 1.21), and negative control
# for patches/crypt-dsa-biased-nonce.patch.
#
# Root cause: Crypt::DSA::Util::makerandom(Size=>N) forces the top bit
# (it produces an *exactly* N-bit integer, for prime search). DSA.pm
# _sign_setup reuses it for the nonce and folds with "k -= q if k >= q".
# Since k_raw is always in [2^(N-1), 2^N-1], the fold leaves the band
# [2^N-q, 2^(N-1)-1] UNREACHABLE -> biased nonce -> private-key recovery
# via the Hidden Number Problem (lattice) given a few hundred signatures.
#
# This PoC observes the ACTUAL signing nonce: _sign_setup leaves
# kinv = k^-1 mod q on the key, so k = kinv^-1 mod q is recoverable after
# each sign(). It signs many messages with one key, recovers each real
# nonce, and counts how many land in the forbidden band.
#
#   biased  (unpatched): 0 nonces ever in the band  -> exit 0 (BUG PRESENT)
#   uniform (patched)  : ~1/3 of nonces in the band -> exit 1 (FIXED)
#
# Container: localhost/dsa-compare (Crypt::DSA 1.21 + Math::BigInt::GMP).
# Build: podman build -t localhost/dsa-compare -f containers/Containerfile.dsa-compare .
# Run:   podman run --rm -v "$PWD/poc:/poc:ro,Z" localhost/dsa-compare perl /poc/poc-crypt-dsa-biased-nonce.pl
use strict; use warnings; $| = 1;
use Crypt::DSA;
use Crypt::DSA::Util qw(mod_inverse bitsize);
use Digest::SHA qw(sha1);
use Math::BigInt lib => 'GMP';

my $key = Crypt::DSA->new->keygen(Size => 1024);   # one long-lived signing key
isa_ok($key, 'Crypt::DSA::Key');
my $q   = $key->q;
my $N   = bitsize($q);
my $half  = Math::BigInt->new(2) ** ($N - 1);       # 2^(N-1)
my $fb_lo = (Math::BigInt->new(2) ** $N) - $q;       # forbidden band start (2^N - q)
my $fb_hi = $half - 1;                               # forbidden band end (2^(N-1)-1)

my $dsa = Crypt::DSA->new;
isa_ok($dsa, 'Crypt::DSA');

my ($in_band, $samples) = (0, 4000);
for my $i (1 .. $samples) {
    $dsa->sign(Key => $key, Digest => sha1("message-$i"));
    my $k = mod_inverse($key->kinv, $q);             # actual nonce used by this sign()
    $in_band++ if $k >= $fb_lo && $k <= $fb_hi;
}

my $band_frac = ($fb_hi - $fb_lo + 1)->numify / $q->numify;   # expected fraction if uniform
diag (sprintf("q: %d bits   forbidden-band fraction if uniform: ~%.2f\n", $N, $band_frac));
diag (sprintf( "real signing nonces sampled: %d   landing in the (formerly forbidden) band: %d",
    $samples, $in_band));

ok($in_band != 0, sprintf("RESULT: nonce uniformly covers [1,q-1] (%.1f%% in band, ~%.0f%% expected) -> FIXED",
        100 * $in_band / $samples, 100 * $band_frac));

done_testing;
