src/keytrans/pem2openpgp

   1 #!/usr/bin/perl -w -T
   2
   3 # pem2openpgp: take a PEM-encoded RSA private-key on standard input, a
   4 # User ID as the first argument, and generate an OpenPGP certificate
   5 # from it.
   6
   7 # Authors:
   8 #  Jameson Rollins <jrollins@finestructure.net>
   9 #  Daniel Kahn Gillmor <dkg@fifthhorseman.net>
  10
  11 # Started on: 2009-01-07 02:01:19-0500
  12
  13 # License: GPL v3 or later (we may need to adjust this given that this
  14 # connects to OpenSSL via perl)
  15
  16 use strict;
  17 use warnings;
  18 use Crypt::OpenSSL::RSA;
  19 use Crypt::OpenSSL::Bignum;
  20 use Digest::SHA1;
  21 use MIME::Base64;
  22
  23 my $holdTerminator = $/;
  24 undef $/;
  25 my $buf = <STDIN>;
  26
  27
  28 my $rsa = Crypt::OpenSSL::RSA->new_private_key($buf);
  29
  30 $rsa->use_sha1_hash();
  31 $rsa->use_no_padding();
  32
  33 if (! $rsa->check_key()) {
  34   die "key does not check";
  35 }
  36
  37 my $uid = 'fake key (do not use) <test@example.org>';
  38
  39
  40
  41 my $version = pack('C', 4);
  42 # strong assertion of identity:
  43 my $sigtype = pack('C', 0x13);
  44 # RSA
  45 my $pubkey_algo = pack('C', 1);
  46 # SHA1
  47 my $hash_algo = pack('C', 2);
  48
  49
  50
  51 my $timestamp = 1231003584;
  52
  53 my $creation_time_packet = pack('CCN', 5, 2, $timestamp);
  54
  55
  56 # usage: signing and certification:
  57 my $flags = 0x03;
  58 my $usage_packet = pack('CCC', 2, 27, $flags);
  59
  60
  61 # expire in 2 days:
  62 my $expires_in = 86400*2;
  63 my $expiration_packet = pack('CCN', 5, 9, $expires_in);
  64
  65
  66 # prefer AES-256, AES-192, AES-128, CAST5, 3DES:
  67 my $pref_sym_algos = pack('CCCCCCC', 6, 11, 9, 8, 7, 3, 2);
  68
  69 # prefer SHA-1, SHA-256, RIPE-MD/160
  70 my $pref_hash_algos = pack('CCCCC', 4, 21, 2, 8, 3);
  71
  72 # prefer ZLIB, BZip2, ZIP
  73 my $pref_zip_algos = pack('CCCCC', 4, 22, 2, 3, 1);
  74
  75 # we support the MDC feature:
  76 my $features = pack('CCC', 2, 30, 1);
  77
  78 # keyserver preference: only owner modify (???):
  79 my $keyserver_pref = pack('CCC', 2, 23, 0x80);
  80
  81 my $subpackets_to_be_hashed =
  82   $creation_time_packet.
  83   $usage_packet.
  84   $expiration_packet.
  85   $pref_sym_algos.
  86   $pref_hash_algos.
  87   $pref_zip_algos.
  88   $features.
  89   $keyserver_pref;
  90
  91 #FIXME: what's the right way to get length()?
  92 my $subpacket_octets = pack('n', length($subpackets_to_be_hashed));
  93
  94 my $sig_data_to_be_hashed =
  95   $version.
  96   $sigtype.
  97   $pubkey_algo.
  98   $hash_algo.
  99   $subpacket_octets.
 100   $subpackets_to_be_hashed;
 101
 102
 103 my ($n, $e, $d, $p, $q) = $rsa->get_key_parameters();
 104
 105
 106 open(KEYFILE, "</home/wt215/gpg-test/key-data");
 107 my $key_data = <KEYFILE>;
 108
 109 # FIXME: $keyid should be generated from the public key instead of
 110 # hardcoded:
 111 my $keyid = '5616d7cb02e69446';
 112
 113 # the v4 signature trailer is:
 114
 115 # version number, literal 0xff, and then a 4-byte count of the
 116 # signature data itself.
 117 my $trailer = pack('CCN', 4, 0xff, length($sig_data_to_be_hashed));
 118
 119 # FIXME: length() is probably not right here either in the event that
 120 # the uid uses unicode.
 121 my $uid_data =
 122   pack('CN', 0xb4, length($uid)).
 123   $uid;
 124
 125 my $datatosign =
 126   $key_data.
 127   $uid_data.
 128   $sig_data_to_be_hashed.
 129   $trailer;
 130
 131 my $data_hash = Digest::SHA1::sha1_hex($datatosign);
 132
 133
 134 my $issuer_packet = pack('CCH16', 9, 16, $keyid);
 135
 136 my $sig = $rsa->sign($datatosign);
 137
 138 my $bigsig = Crypt::OpenSSL::Bignum->new_from_bin($sig);
 139
 140
 141 my $hex = $bigsig->to_hex();
 142
 143 my $mpilen = length($hex)*4;
 144
 145 # this is a kludgy way to get the number of bits in the first byte:
 146 my $bitsinfirstbyte = length(sprintf("%b", hex(substr $hex, 0, 2)));
 147
 148 $mpilen -= (8 - $bitsinfirstbyte);
 149
 150 # emit two octets representing $mpilen, followed by the signature itself:
 151
 152
 153 my $sig_body =
 154   $sig_data_to_be_hashed.
 155 # FIXME: another dubious length() call.
 156   pack('n', length($issuer_packet)).
 157   $issuer_packet.
 158   pack('n', hex(substr($data_hash, 0, 4))).
 159   pack("n" , $mpilen).
 160   $sig;
 161
 162 # FIXME: yet another length():
 163 my $len = length($sig_body);
 164
 165 my $header;
 166
 167 if ($len < 2**8) {
 168   $header = pack('CC', 0x88, $len);
 169 } elsif ($len < 2**16) {
 170   $header = pack('Cn', 0x89, $len);
 171 } elsif ($len < 2**31) {
 172   $header = pack('CN', 0x8a, $len);
 173 } else {
 174   # what the hell do we do here?
 175   $header = pack('C', 0x8b);
 176 }
 177
 178 print $header.$sig_body;
 179
 180 $/ = $holdTerminator;