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