summaryrefslogtreecommitdiff
path: root/src/share/keytrans
blob: 326bfb1e6cd0cf590bcfb3c19718038b81746e3e (plain)
  1. #!/usr/bin/perl -T
  2. # keytrans: this is an RSA key translation utility; it is capable of
  3. # transforming RSA keys (both public keys and secret keys) between
  4. # several popular representations, including OpenPGP, PEM-encoded
  5. # PKCS#1 DER, and OpenSSH-style public key lines.
  6. # How it behaves depends on the name under which it is invoked. The
  7. # two implementations currently are: pem2openpgp and openpgp2ssh.
  8. # pem2openpgp: take a PEM-encoded RSA private-key on standard input, a
  9. # User ID as the first argument, and generate an OpenPGP secret key
  10. # and certificate from it.
  11. # WARNING: the secret key material *will* appear on stdout (albeit in
  12. # OpenPGP form) -- if you redirect stdout to a file, make sure the
  13. # permissions on that file are appropriately locked down!
  14. # Usage:
  15. # pem2openpgp 'ssh://'$(hostname -f) < /etc/ssh/ssh_host_rsa_key | gpg --import
  16. # openpgp2ssh: take a stream of OpenPGP packets containing public or
  17. # secret key material on standard input, and a Key ID (or fingerprint)
  18. # as the first argument. Find the matching key in the input stream,
  19. # and emit it on stdout in an OpenSSH-compatible format. If the input
  20. # key is an OpenPGP public key (either primary or subkey), the output
  21. # will be an OpenSSH single-line public key. If the input key is an
  22. # OpenPGP secret key, the output will be a PEM-encoded RSA key.
  23. # Example usage:
  24. # gpg --export-secret-subkeys --export-options export-reset-subkey-passwd $KEYID | \
  25. # openpgp2ssh $KEYID | ssh-add /dev/stdin
  26. # Authors:
  27. # Jameson Rollins <jrollins@finestructure.net>
  28. # Daniel Kahn Gillmor <dkg@fifthhorseman.net>
  29. # Started on: 2009-01-07 02:01:19-0500
  30. # License: GPL v3 or later (we may need to adjust this given that this
  31. # connects to OpenSSL via perl)
  32. use strict;
  33. use warnings;
  34. use File::Basename;
  35. use Crypt::OpenSSL::RSA;
  36. use Crypt::OpenSSL::Bignum;
  37. use Crypt::OpenSSL::Bignum::CTX;
  38. use Digest::SHA1;
  39. use MIME::Base64;
  40. use POSIX;
  41. ## make sure all length() and substr() calls use bytes only:
  42. use bytes;
  43. my $old_format_packet_lengths = { one => 0,
  44. two => 1,
  45. four => 2,
  46. indeterminate => 3,
  47. };
  48. # see RFC 4880 section 9.1 (ignoring deprecated algorithms for now)
  49. my $asym_algos = { rsa => 1,
  50. elgamal => 16,
  51. dsa => 17,
  52. };
  53. # see RFC 4880 section 9.2
  54. my $ciphers = { plaintext => 0,
  55. idea => 1,
  56. tripledes => 2,
  57. cast5 => 3,
  58. blowfish => 4,
  59. aes128 => 7,
  60. aes192 => 8,
  61. aes256 => 9,
  62. twofish => 10,
  63. };
  64. # see RFC 4880 section 9.3
  65. my $zips = { uncompressed => 0,
  66. zip => 1,
  67. zlib => 2,
  68. bzip2 => 3,
  69. };
  70. # see RFC 4880 section 9.4
  71. my $digests = { md5 => 1,
  72. sha1 => 2,
  73. ripemd160 => 3,
  74. sha256 => 8,
  75. sha384 => 9,
  76. sha512 => 10,
  77. sha224 => 11,
  78. };
  79. # see RFC 4880 section 5.2.3.21
  80. my $usage_flags = { certify => 0x01,
  81. sign => 0x02,
  82. encrypt_comms => 0x04,
  83. encrypt_storage => 0x08,
  84. encrypt => 0x0c, ## both comms and storage
  85. split => 0x10, # the private key is split via secret sharing
  86. authenticate => 0x20,
  87. shared => 0x80, # more than one person holds the entire private key
  88. };
  89. # see RFC 4880 section 4.3
  90. my $packet_types = { pubkey_enc_session => 1,
  91. sig => 2,
  92. symkey_enc_session => 3,
  93. onepass_sig => 4,
  94. seckey => 5,
  95. pubkey => 6,
  96. sec_subkey => 7,
  97. compressed_data => 8,
  98. symenc_data => 9,
  99. marker => 10,
  100. literal => 11,
  101. trust => 12,
  102. uid => 13,
  103. pub_subkey => 14,
  104. uat => 17,
  105. symenc_w_integrity => 18,
  106. mdc => 19,
  107. };
  108. # see RFC 4880 section 5.2.1
  109. my $sig_types = { binary_doc => 0x00,
  110. text_doc => 0x01,
  111. standalone => 0x02,
  112. generic_certification => 0x10,
  113. persona_certification => 0x11,
  114. casual_certification => 0x12,
  115. positive_certification => 0x13,
  116. subkey_binding => 0x18,
  117. primary_key_binding => 0x19,
  118. key_signature => 0x1f,
  119. key_revocation => 0x20,
  120. subkey_revocation => 0x28,
  121. certification_revocation => 0x30,
  122. timestamp => 0x40,
  123. thirdparty => 0x50,
  124. };
  125. # see RFC 4880 section 5.2.3.1
  126. my $subpacket_types = { sig_creation_time => 2,
  127. sig_expiration_time => 3,
  128. exportable => 4,
  129. trust_sig => 5,
  130. regex => 6,
  131. revocable => 7,
  132. key_expiration_time => 9,
  133. preferred_cipher => 11,
  134. revocation_key => 12,
  135. issuer => 16,
  136. notation => 20,
  137. preferred_digest => 21,
  138. preferred_compression => 22,
  139. keyserver_prefs => 23,
  140. preferred_keyserver => 24,
  141. primary_uid => 25,
  142. policy_uri => 26,
  143. usage_flags => 27,
  144. signers_uid => 28,
  145. revocation_reason => 29,
  146. features => 30,
  147. signature_target => 31,
  148. embedded_signature => 32,
  149. };
  150. # bitstring (see RFC 4880 section 5.2.3.24)
  151. my $features = { mdc => 0x01
  152. };
  153. # bitstring (see RFC 4880 5.2.3.17)
  154. my $keyserver_prefs = { nomodify => 0x80
  155. };
  156. ###### end lookup tables ######
  157. # FIXME: if we want to be able to interpret openpgp data as well as
  158. # produce it, we need to produce key/value-swapped lookup tables as well.
  159. ########### Math/Utility Functions ##############
  160. # see the bottom of page 44 of RFC 4880 (http://tools.ietf.org/html/rfc4880#page-44)
  161. sub simple_checksum {
  162. my $bytes = shift;
  163. return unpack("%16C*",$bytes);
  164. }
  165. # calculate the multiplicative inverse of a mod b this is euclid's
  166. # extended algorithm. For more information see:
  167. # http://en.wikipedia.org/wiki/Extended_Euclidean_algorithm the
  168. # arguments here should be Crypt::OpenSSL::Bignum objects. $a should
  169. # be the larger of the two values, and the two values should be
  170. # coprime.
  171. sub modular_multi_inverse {
  172. my $a = shift;
  173. my $b = shift;
  174. my $origdivisor = $b->copy();
  175. my $ctx = Crypt::OpenSSL::Bignum::CTX->new();
  176. my $x = Crypt::OpenSSL::Bignum->zero();
  177. my $y = Crypt::OpenSSL::Bignum->one();
  178. my $lastx = Crypt::OpenSSL::Bignum->one();
  179. my $lasty = Crypt::OpenSSL::Bignum->zero();
  180. my $finalquotient;
  181. my $finalremainder;
  182. while (! $b->is_zero()) {
  183. my ($quotient, $remainder) = $a->div($b, $ctx);
  184. $a = $b;
  185. $b = $remainder;
  186. my $temp = $x;
  187. $x = $lastx->sub($quotient->mul($x, $ctx));
  188. $lastx = $temp;
  189. $temp = $y;
  190. $y = $lasty->sub($quotient->mul($y, $ctx));
  191. $lasty = $temp;
  192. }
  193. if (!$a->is_one()) {
  194. die "did this math wrong.\n";
  195. }
  196. # let's make sure that we return a positive value because RFC 4880,
  197. # section 3.2 only allows unsigned values:
  198. ($finalquotient, $finalremainder) = $lastx->add($origdivisor)->div($origdivisor, $ctx);
  199. return $finalremainder;
  200. }
  201. ############ OpenPGP formatting functions ############
  202. # make an old-style packet out of the given packet type and body.
  203. # old-style (see RFC 4880 section 4.2)
  204. sub make_packet {
  205. my $type = shift;
  206. my $body = shift;
  207. my $options = shift;
  208. my $len = length($body);
  209. my $pseudolen = $len;
  210. # if the caller wants to use at least N octets of packet length,
  211. # pretend that we're using that many.
  212. if (defined $options && defined $options->{'packet_length'}) {
  213. $pseudolen = 2**($options->{'packet_length'} * 8) - 1;
  214. }
  215. if ($pseudolen < $len) {
  216. $pseudolen = $len;
  217. }
  218. my $lenbytes;
  219. my $lencode;
  220. if ($pseudolen < 2**8) {
  221. $lenbytes = $old_format_packet_lengths->{one};
  222. $lencode = 'C';
  223. } elsif ($pseudolen < 2**16) {
  224. $lenbytes = $old_format_packet_lengths->{two};
  225. $lencode = 'n';
  226. } elsif ($pseudolen < 2**31) {
  227. ## not testing against full 32 bits because i don't want to deal
  228. ## with potential overflow.
  229. $lenbytes = $old_format_packet_lengths->{four};
  230. $lencode = 'N';
  231. } else {
  232. ## what the hell do we do here?
  233. $lenbytes = $old_format_packet_lengths->{indeterminate};
  234. $lencode = '';
  235. }
  236. return pack('C'.$lencode, 0x80 + ($type * 4) + $lenbytes, $len).
  237. $body;
  238. }
  239. # takes a Crypt::OpenSSL::Bignum, returns it formatted as OpenPGP MPI
  240. # (RFC 4880 section 3.2)
  241. sub mpi_pack {
  242. my $num = shift;
  243. my $val = $num->to_bin();
  244. my $mpilen = length($val)*8;
  245. # this is a kludgy way to get the number of significant bits in the
  246. # first byte:
  247. my $bitsinfirstbyte = length(sprintf("%b", ord($val)));
  248. $mpilen -= (8 - $bitsinfirstbyte);
  249. return pack('n', $mpilen).$val;
  250. }
  251. # takes a Crypt::OpenSSL::Bignum, returns an MPI packed in preparation
  252. # for an OpenSSH-style public key format. see:
  253. # http://marc.info/?l=openssh-unix-dev&m=121866301718839&w=2
  254. sub openssh_mpi_pack {
  255. my $num = shift;
  256. my $val = $num->to_bin();
  257. my $mpilen = length($val);
  258. my $ret = pack('N', $mpilen);
  259. # if the first bit of the leading byte is high, we should include a
  260. # 0 byte:
  261. if (ord($val) & 0x80) {
  262. $ret = pack('NC', $mpilen+1, 0);
  263. }
  264. return $ret.$val;
  265. }
  266. sub openssh_pubkey_pack {
  267. my $key = shift;
  268. my ($modulus, $exponent) = $key->get_key_parameters();
  269. return openssh_mpi_pack(Crypt::OpenSSL::Bignum->new_from_bin("ssh-rsa")).
  270. openssh_mpi_pack($exponent).
  271. openssh_mpi_pack($modulus);
  272. }
  273. # pull an OpenPGP-specified MPI off of a given stream, returning it as
  274. # a Crypt::OpenSSL::Bignum.
  275. sub read_mpi {
  276. my $instr = shift;
  277. my $readtally = shift;
  278. my $bitlen;
  279. read($instr, $bitlen, 2) or die "could not read MPI length.\n";
  280. $bitlen = unpack('n', $bitlen);
  281. $$readtally += 2;
  282. my $bytestoread = POSIX::floor(($bitlen + 7)/8);
  283. my $ret;
  284. read($instr, $ret, $bytestoread) or die "could not read MPI body.\n";
  285. $$readtally += $bytestoread;
  286. return Crypt::OpenSSL::Bignum->new_from_bin($ret);
  287. }
  288. # FIXME: genericize these to accept either RSA or DSA keys:
  289. sub make_rsa_pub_key_body {
  290. my $key = shift;
  291. my $key_timestamp = shift;
  292. my ($n, $e) = $key->get_key_parameters();
  293. return
  294. pack('CN', 4, $key_timestamp).
  295. pack('C', $asym_algos->{rsa}).
  296. mpi_pack($n).
  297. mpi_pack($e);
  298. }
  299. sub make_rsa_sec_key_body {
  300. my $key = shift;
  301. my $key_timestamp = shift;
  302. # we're not using $a and $b, but we need them to get to $c.
  303. my ($n, $e, $d, $p, $q) = $key->get_key_parameters();
  304. my $c3 = modular_multi_inverse($p, $q);
  305. my $secret_material = mpi_pack($d).
  306. mpi_pack($p).
  307. mpi_pack($q).
  308. mpi_pack($c3);
  309. # according to Crypt::OpenSSL::RSA, the closest value we can get out
  310. # of get_key_parameters is 1/q mod p; but according to sec 5.5.3 of
  311. # RFC 4880, we're actually looking for u, the multiplicative inverse
  312. # of p, mod q. This is why we're calculating the value directly
  313. # with modular_multi_inverse.
  314. return
  315. pack('CN', 4, $key_timestamp).
  316. pack('C', $asym_algos->{rsa}).
  317. mpi_pack($n).
  318. mpi_pack($e).
  319. pack('C', 0). # seckey material is not encrypted -- see RFC 4880 sec 5.5.3
  320. $secret_material.
  321. pack('n', simple_checksum($secret_material));
  322. }
  323. # expects an RSA key (public or private) and a timestamp
  324. sub fingerprint {
  325. my $key = shift;
  326. my $key_timestamp = shift;
  327. my $rsabody = make_rsa_pub_key_body($key, $key_timestamp);
  328. return Digest::SHA1::sha1(pack('Cn', 0x99, length($rsabody)).$rsabody);
  329. }
  330. # FIXME: handle DSA keys as well!
  331. sub pem2openpgp {
  332. my $rsa = shift;
  333. my $uid = shift;
  334. my $args = shift;
  335. $rsa->use_sha256_hash();
  336. # see page 22 of RFC 4880 for why i think this is the right padding
  337. # choice to use:
  338. $rsa->use_pkcs1_padding();
  339. if (! $rsa->check_key()) {
  340. die "key does not check";
  341. }
  342. # strong assertion of identity is the default (for a self-sig):
  343. my $certtype = $sig_types->{positive_certification};
  344. if (defined $args->{certification_type}) {
  345. $certtype = $args->{certification_type} + 0;
  346. }
  347. my $version = pack('C', 4);
  348. my $sigtype = pack('C', $certtype);
  349. # RSA
  350. my $pubkey_algo = pack('C', $asym_algos->{rsa});
  351. # SHA1
  352. my $hash_algo = pack('C', $digests->{sha256});
  353. # FIXME: i'm worried about generating a bazillion new OpenPGP
  354. # certificates from the same key, which could easily happen if you run
  355. # this script more than once against the same key (because the
  356. # timestamps will differ). How can we prevent this?
  357. # this argument (if set) overrides the current time, to
  358. # be able to create a standard key. If we read the key from a file
  359. # instead of stdin, should we use the creation time on the file?
  360. my $sig_timestamp = 0;
  361. if (defined $args->{sig_timestamp}) {
  362. $sig_timestamp = ($args->{sig_timestamp} + 0);
  363. } else {
  364. $sig_timestamp = time();
  365. }
  366. my $key_timestamp = $sig_timestamp;
  367. if (defined $args->{key_timestamp}) {
  368. $key_timestamp = ($args->{key_timestamp} + 0);
  369. }
  370. if ($key_timestamp > $sig_timestamp) {
  371. die "key timestamp must not be later than signature timestamp";
  372. }
  373. my $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $sig_timestamp);
  374. my $flags = 0;
  375. if (! defined $args->{usage_flags}) {
  376. $flags = $usage_flags->{certify};
  377. } else {
  378. my @ff = split(",", $args->{usage_flags});
  379. foreach my $f (@ff) {
  380. if (! defined $usage_flags->{$f}) {
  381. die "No such flag $f";
  382. }
  383. $flags |= $usage_flags->{$f};
  384. }
  385. }
  386. my $usage_packet = pack('CCC', 2, $subpacket_types->{usage_flags}, $flags);
  387. # how should we determine how far off to set the expiration date?
  388. # default is no expiration. Specify the timestamp in seconds from the
  389. # key creation.
  390. my $expiration_packet = '';
  391. if (defined $args->{expiration}) {
  392. my $expires_in = $args->{expiration} + 0;
  393. $expiration_packet = pack('CCN', 5, $subpacket_types->{key_expiration_time}, $expires_in);
  394. }
  395. # prefer AES-256, AES-192, AES-128, CAST5, 3DES:
  396. my $pref_sym_algos = pack('CCCCCCC', 6, $subpacket_types->{preferred_cipher},
  397. $ciphers->{aes256},
  398. $ciphers->{aes192},
  399. $ciphers->{aes128},
  400. $ciphers->{cast5},
  401. $ciphers->{tripledes}
  402. );
  403. # prefer SHA-512, SHA-384, SHA-256, SHA-224, RIPE-MD/160, SHA-1
  404. my $pref_hash_algos = pack('CCCCCCCC', 7, $subpacket_types->{preferred_digest},
  405. $digests->{sha512},
  406. $digests->{sha384},
  407. $digests->{sha256},
  408. $digests->{sha224},
  409. $digests->{ripemd160},
  410. $digests->{sha1}
  411. );
  412. # prefer ZLIB, BZip2, ZIP
  413. my $pref_zip_algos = pack('CCCCC', 4, $subpacket_types->{preferred_compression},
  414. $zips->{zlib},
  415. $zips->{bzip2},
  416. $zips->{zip}
  417. );
  418. # we support the MDC feature:
  419. my $feature_subpacket = pack('CCC', 2, $subpacket_types->{features},
  420. $features->{mdc});
  421. # keyserver preference: only owner modify (???):
  422. my $keyserver_pref = pack('CCC', 2, $subpacket_types->{keyserver_prefs},
  423. $keyserver_prefs->{nomodify});
  424. my $subpackets_to_be_hashed =
  425. $creation_time_packet.
  426. $usage_packet.
  427. $expiration_packet.
  428. $pref_sym_algos.
  429. $pref_hash_algos.
  430. $pref_zip_algos.
  431. $feature_subpacket.
  432. $keyserver_pref;
  433. my $subpacket_octets = pack('n', length($subpackets_to_be_hashed));
  434. my $sig_data_to_be_hashed =
  435. $version.
  436. $sigtype.
  437. $pubkey_algo.
  438. $hash_algo.
  439. $subpacket_octets.
  440. $subpackets_to_be_hashed;
  441. my $pubkey = make_rsa_pub_key_body($rsa, $key_timestamp);
  442. my $seckey = make_rsa_sec_key_body($rsa, $key_timestamp);
  443. # this is for signing. it needs to be an old-style header with a
  444. # 2-packet octet count.
  445. my $key_data = make_packet($packet_types->{pubkey}, $pubkey, {'packet_length'=>2});
  446. # take the last 8 bytes of the fingerprint as the keyid:
  447. my $keyid = substr(fingerprint($rsa, $key_timestamp), 20 - 8, 8);
  448. # the v4 signature trailer is:
  449. # version number, literal 0xff, and then a 4-byte count of the
  450. # signature data itself.
  451. my $trailer = pack('CCN', 4, 0xff, length($sig_data_to_be_hashed));
  452. my $uid_data =
  453. pack('CN', 0xb4, length($uid)).
  454. $uid;
  455. my $datatosign =
  456. $key_data.
  457. $uid_data.
  458. $sig_data_to_be_hashed.
  459. $trailer;
  460. my $data_hash = Digest::SHA1::sha1_hex($datatosign);
  461. my $issuer_packet = pack('CCa8', 9, $subpacket_types->{issuer}, $keyid);
  462. my $sig = Crypt::OpenSSL::Bignum->new_from_bin($rsa->sign($datatosign));
  463. my $sig_body =
  464. $sig_data_to_be_hashed.
  465. pack('n', length($issuer_packet)).
  466. $issuer_packet.
  467. pack('n', hex(substr($data_hash, 0, 4))).
  468. mpi_pack($sig);
  469. return
  470. make_packet($packet_types->{seckey}, $seckey).
  471. make_packet($packet_types->{uid}, $uid).
  472. make_packet($packet_types->{sig}, $sig_body);
  473. }
  474. sub openpgp2ssh {
  475. my $instr = shift;
  476. my $fpr = shift;
  477. if (defined $fpr) {
  478. if (length($fpr) < 8) {
  479. die "We need at least 8 hex digits of fingerprint.\n";
  480. }
  481. $fpr = uc($fpr);
  482. }
  483. my $packettag;
  484. my $dummy;
  485. my $tag;
  486. my $key;
  487. while (! eof($instr)) {
  488. read($instr, $packettag, 1);
  489. $packettag = ord($packettag);
  490. my $packetlen;
  491. if ( ! (0x80 & $packettag)) {
  492. die "This is not an OpenPGP packet\n";
  493. }
  494. if (0x40 & $packettag) {
  495. # this is a new-format packet.
  496. $tag = (0x3f & $packettag);
  497. my $nextlen = 0;
  498. read($instr, $nextlen, 1);
  499. $nextlen = ord($nextlen);
  500. if ($nextlen < 192) {
  501. $packetlen = $nextlen;
  502. } elsif ($nextlen < 224) {
  503. my $newoct;
  504. read($instr, $newoct, 1);
  505. $newoct = ord($newoct);
  506. $packetlen = (($nextlen - 192) << 8) + ($newoct) + 192;
  507. } elsif ($nextlen == 255) {
  508. read($instr, $nextlen, 4);
  509. $packetlen = unpack('N', $nextlen);
  510. } else {
  511. # packet length is undefined.
  512. }
  513. } else {
  514. # this is an old-format packet.
  515. my $lentype;
  516. $lentype = 0x03 & $packettag;
  517. $tag = ( 0x3c & $packettag ) >> 2;
  518. if ($lentype == 0) {
  519. read($instr, $packetlen, 1) or die "could not read packet length\n";
  520. $packetlen = unpack('C', $packetlen);
  521. } elsif ($lentype == 1) {
  522. read($instr, $packetlen, 2) or die "could not read packet length\n";
  523. $packetlen = unpack('n', $packetlen);
  524. } elsif ($lentype == 2) {
  525. read($instr, $packetlen, 4) or die "could not read packet length\n";
  526. $packetlen = unpack('N', $packetlen);
  527. } else {
  528. # packet length is undefined.
  529. }
  530. }
  531. if (! defined($packetlen)) {
  532. die "Undefined packet lengths are not supported.\n";
  533. }
  534. if ($tag == $packet_types->{pubkey} ||
  535. $tag == $packet_types->{pub_subkey} ||
  536. $tag == $packet_types->{seckey} ||
  537. $tag == $packet_types->{sec_subkey}) {
  538. my $ver;
  539. my $readbytes = 0;
  540. read($instr, $ver, 1) or die "could not read key version\n";
  541. $readbytes += 1;
  542. $ver = ord($ver);
  543. if ($ver != 4) {
  544. printf(STDERR "We only work with version 4 keys. This key appears to be version %s.\n", $ver);
  545. read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
  546. } else {
  547. my $key_timestamp;
  548. read($instr, $key_timestamp, 4) or die "could not read key timestamp.\n";
  549. $readbytes += 4;
  550. $key_timestamp = unpack('N', $key_timestamp);
  551. my $algo;
  552. read($instr, $algo, 1) or die "could not read key algorithm.\n";
  553. $readbytes += 1;
  554. $algo = ord($algo);
  555. if ($algo != $asym_algos->{rsa}) {
  556. printf(STDERR "We only support RSA keys (this key used algorithm %d).\n", $algo);
  557. read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
  558. } else {
  559. ## we have an RSA key.
  560. my $modulus = read_mpi($instr, \$readbytes);
  561. my $exponent = read_mpi($instr, \$readbytes);
  562. my $pubkey = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus, $exponent);
  563. my $foundfpr = fingerprint($pubkey, $key_timestamp);
  564. my $foundfprstr = Crypt::OpenSSL::Bignum->new_from_bin($foundfpr)->to_hex();
  565. # left-pad with 0's to bring up to full 40-char (160-bit) fingerprint:
  566. $foundfprstr = sprintf("%040s", $foundfprstr);
  567. # is this a match?
  568. if ((!defined($fpr)) ||
  569. (substr($foundfprstr, -1 * length($fpr)) eq $fpr)) {
  570. if (defined($key)) {
  571. die "Found two matching keys.\n";
  572. }
  573. $key = $pubkey;
  574. }
  575. if ($tag == $packet_types->{seckey} ||
  576. $tag == $packet_types->{sec_subkey}) {
  577. if (!defined($key)) { # we don't think the public part of
  578. # this key matches
  579. read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
  580. } else {
  581. my $s2k;
  582. read($instr, $s2k, 1) or die "Could not read S2K octet.\n";
  583. $readbytes += 1;
  584. $s2k = ord($s2k);
  585. if ($s2k == 0) {
  586. # secret material is unencrypted
  587. # see http://tools.ietf.org/html/rfc4880#section-5.5.3
  588. my $d = read_mpi($instr, \$readbytes);
  589. my $p = read_mpi($instr, \$readbytes);
  590. my $q = read_mpi($instr, \$readbytes);
  591. my $u = read_mpi($instr, \$readbytes);
  592. my $checksum;
  593. read($instr, $checksum, 2) or die "Could not read checksum of secret key material.\n";
  594. $readbytes += 2;
  595. $checksum = unpack('n', $checksum);
  596. # FIXME: compare with the checksum! how? the data is
  597. # gone into the Crypt::OpenSSL::Bignum
  598. $key = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus,
  599. $exponent,
  600. $d,
  601. $p,
  602. $q);
  603. $key->check_key() or die "Secret key is not a valid RSA key.\n";
  604. } else {
  605. print(STDERR "We cannot handle encrypted secret keys. Skipping!\n") ;
  606. read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
  607. }
  608. }
  609. }
  610. }
  611. }
  612. } else {
  613. read($instr, $dummy, $packetlen) or die "Could not skip past this packet!\n";
  614. }
  615. }
  616. return $key;
  617. }
  618. for (basename($0)) {
  619. if (/^pem2openpgp$/) {
  620. my $rsa;
  621. my $stdin;
  622. my $uid = shift;
  623. defined($uid) or die "You must specify a user ID string.\n";
  624. # FIXME: fail if there is no given user ID; or should we default to
  625. # hostname_long() from Sys::Hostname::Long ?
  626. if (defined $ENV{PEM2OPENPGP_NEWKEY}) {
  627. $rsa = Crypt::OpenSSL::RSA->generate_key($ENV{PEM2OPENPGP_NEWKEY});
  628. } else {
  629. $stdin = do {
  630. local $/; # slurp!
  631. <STDIN>;
  632. };
  633. $rsa = Crypt::OpenSSL::RSA->new_private_key($stdin);
  634. }
  635. print pem2openpgp($rsa,
  636. $uid,
  637. { sig_timestamp => $ENV{PEM2OPENPGP_TIMESTAMP},
  638. key_timestamp => $ENV{PEM2OPENPGP_KEY_TIMESTAMP},
  639. expiration => $ENV{PEM2OPENPGP_EXPIRATION},
  640. usage_flags => $ENV{PEM2OPENPGP_USAGE_FLAGS},
  641. }
  642. );
  643. }
  644. elsif (/^openpgp2ssh$/) {
  645. my $fpr = shift;
  646. my $instream;
  647. open($instream,'-');
  648. binmode($instream, ":bytes");
  649. my $key = openpgp2ssh($instream, $fpr);
  650. if (defined($key)) {
  651. if ($key->is_private()) {
  652. print $key->get_private_key_string();
  653. } else {
  654. print "ssh-rsa ".encode_base64(openssh_pubkey_pack($key), '')."\n";
  655. }
  656. } else {
  657. die "No matching key found.\n";
  658. }
  659. }
  660. else {
  661. die "Unrecognized keytrans call.\n";
  662. }
  663. }