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