From 2c427b22f6a780cbf0d4e22fce26071727e985a1 Mon Sep 17 00:00:00 2001 From: Daniel Kahn Gillmor Date: Sun, 1 Mar 2009 11:45:38 -0500 Subject: transition to the perl-based keytrans implementation. --- src/share/keytrans | 775 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 775 insertions(+) create mode 100755 src/share/keytrans (limited to 'src/share/keytrans') diff --git a/src/share/keytrans b/src/share/keytrans new file mode 100755 index 0000000..8bf17fb --- /dev/null +++ b/src/share/keytrans @@ -0,0 +1,775 @@ +#!/usr/bin/perl -w -T + +# pem2openpgp: take a PEM-encoded RSA private-key on standard input, a +# User ID as the first argument, and generate an OpenPGP secret key +# and certificate from it. + +# WARNING: the secret key material *will* appear on stdout (albeit in +# OpenPGP form) -- if you redirect stdout to a file, make sure the +# permissions on that file are appropriately locked down! + +# Usage: + +# pem2openpgp 'ssh://'$(hostname -f) < /etc/ssh/ssh_host_rsa_key | gpg --import + +# Authors: +# Jameson Rollins +# Daniel Kahn Gillmor + +# Started on: 2009-01-07 02:01:19-0500 + +# License: GPL v3 or later (we may need to adjust this given that this +# connects to OpenSSL via perl) + +use strict; +use warnings; +use File::Basename; +use Crypt::OpenSSL::RSA; +use Crypt::OpenSSL::Bignum; +use Crypt::OpenSSL::Bignum::CTX; +use Digest::SHA1; +use MIME::Base64; +use POSIX; + +## make sure all length() and substr() calls use bytes only: +use bytes; + +my $old_format_packet_lengths = { one => 0, + two => 1, + four => 2, + indeterminate => 3, +}; + +# see RFC 4880 section 9.1 (ignoring deprecated algorithms for now) +my $asym_algos = { rsa => 1, + elgamal => 16, + dsa => 17, + }; + +# see RFC 4880 section 9.2 +my $ciphers = { plaintext => 0, + idea => 1, + tripledes => 2, + cast5 => 3, + blowfish => 4, + aes128 => 7, + aes192 => 8, + aes256 => 9, + twofish => 10, + }; + +# see RFC 4880 section 9.3 +my $zips = { uncompressed => 0, + zip => 1, + zlib => 2, + bzip2 => 3, + }; + +# see RFC 4880 section 9.4 +my $digests = { md5 => 1, + sha1 => 2, + ripemd160 => 3, + sha256 => 8, + sha384 => 9, + sha512 => 10, + sha224 => 11, + }; + +# see RFC 4880 section 5.2.3.21 +my $usage_flags = { certify => 0x01, + sign => 0x02, + encrypt_comms => 0x04, + encrypt_storage => 0x08, + encrypt => 0x0c, ## both comms and storage + split => 0x10, # the private key is split via secret sharing + authenticate => 0x20, + shared => 0x80, # more than one person holds the entire private key + }; + +# see RFC 4880 section 4.3 +my $packet_types = { pubkey_enc_session => 1, + sig => 2, + symkey_enc_session => 3, + onepass_sig => 4, + seckey => 5, + pubkey => 6, + sec_subkey => 7, + compressed_data => 8, + symenc_data => 9, + marker => 10, + literal => 11, + trust => 12, + uid => 13, + pub_subkey => 14, + uat => 17, + symenc_w_integrity => 18, + mdc => 19, + }; + +# see RFC 4880 section 5.2.1 +my $sig_types = { binary_doc => 0x00, + text_doc => 0x01, + standalone => 0x02, + generic_certification => 0x10, + persona_certification => 0x11, + casual_certification => 0x12, + positive_certification => 0x13, + subkey_binding => 0x18, + primary_key_binding => 0x19, + key_signature => 0x1f, + key_revocation => 0x20, + subkey_revocation => 0x28, + certification_revocation => 0x30, + timestamp => 0x40, + thirdparty => 0x50, + }; + + +# see RFC 4880 section 5.2.3.1 +my $subpacket_types = { sig_creation_time => 2, + sig_expiration_time => 3, + exportable => 4, + trust_sig => 5, + regex => 6, + revocable => 7, + key_expiration_time => 9, + preferred_cipher => 11, + revocation_key => 12, + issuer => 16, + notation => 20, + preferred_digest => 21, + preferred_compression => 22, + keyserver_prefs => 23, + preferred_keyserver => 24, + primary_uid => 25, + policy_uri => 26, + usage_flags => 27, + signers_uid => 28, + revocation_reason => 29, + features => 30, + signature_target => 31, + embedded_signature => 32, + }; + +# bitstring (see RFC 4880 section 5.2.3.24) +my $features = { mdc => 0x01 + }; + +# bitstring (see RFC 4880 5.2.3.17) +my $keyserver_prefs = { nomodify => 0x80 + }; + +###### end lookup tables ###### + +# FIXME: if we want to be able to interpret openpgp data as well as +# produce it, we need to produce key/value-swapped lookup tables as well. + + +########### Math/Utility Functions ############## + + +# see the bottom of page 43 of RFC 4880 +sub simple_checksum { + my $bytes = shift; + + return unpack("%32W*",$bytes) % 65536; +} + +# calculate the multiplicative inverse of a mod b this is euclid's +# extended algorithm. For more information see: +# http://en.wikipedia.org/wiki/Extended_Euclidean_algorithm the +# arguments here should be Crypt::OpenSSL::Bignum objects. $a should +# be the larger of the two values, and the two values should be +# coprime. + +sub modular_multi_inverse { + my $a = shift; + my $b = shift; + + + my $origdivisor = $b->copy(); + + my $ctx = Crypt::OpenSSL::Bignum::CTX->new(); + my $x = Crypt::OpenSSL::Bignum->zero(); + my $y = Crypt::OpenSSL::Bignum->one(); + my $lastx = Crypt::OpenSSL::Bignum->one(); + my $lasty = Crypt::OpenSSL::Bignum->zero(); + + my $finalquotient; + my $finalremainder; + + while (! $b->is_zero()) { + my ($quotient, $remainder) = $a->div($b, $ctx); + + $a = $b; + $b = $remainder; + + my $temp = $x; + $x = $lastx->sub($quotient->mul($x, $ctx)); + $lastx = $temp; + + $temp = $y; + $y = $lasty->sub($quotient->mul($y, $ctx)); + $lasty = $temp; + } + + if (!$a->is_one()) { + die "did this math wrong.\n"; + } + + # let's make sure that we return a positive value because RFC 4880, + # section 3.2 only allows unsigned values: + + ($finalquotient, $finalremainder) = $lastx->add($origdivisor)->div($origdivisor, $ctx); + + return $finalremainder; +} + + +############ OpenPGP formatting functions ############ + +# make an old-style packet out of the given packet type and body. +# old-style (see RFC 4880 section 4.2) +sub make_packet { + my $type = shift; + my $body = shift; + my $options = shift; + + my $len = length($body); + my $pseudolen = $len; + + # if the caller wants to use at least N octets of packet length, + # pretend that we're using that many. + if (defined $options && defined $options->{'packet_length'}) { + $pseudolen = 2**($options->{'packet_length'} * 8) - 1; + } + if ($pseudolen < $len) { + $pseudolen = $len; + } + + my $lenbytes; + my $lencode; + + if ($pseudolen < 2**8) { + $lenbytes = $old_format_packet_lengths->{one}; + $lencode = 'C'; + } elsif ($pseudolen < 2**16) { + $lenbytes = $old_format_packet_lengths->{two}; + $lencode = 'n'; + } elsif ($pseudolen < 2**31) { + ## not testing against full 32 bits because i don't want to deal + ## with potential overflow. + $lenbytes = $old_format_packet_lengths->{four}; + $lencode = 'N'; + } else { + ## what the hell do we do here? + $lenbytes = $old_format_packet_lengths->{indeterminate}; + $lencode = ''; + } + + return pack('C'.$lencode, 0x80 + ($type * 4) + $lenbytes, $len). + $body; +} + + +# takes a Crypt::OpenSSL::Bignum, returns it formatted as OpenPGP MPI +# (RFC 4880 section 3.2) +sub mpi_pack { + my $num = shift; + + my $val = $num->to_bin(); + my $mpilen = length($val)*8; + +# this is a kludgy way to get the number of significant bits in the +# first byte: + my $bitsinfirstbyte = length(sprintf("%b", ord($val))); + + $mpilen -= (8 - $bitsinfirstbyte); + + return pack('n', $mpilen).$val; +} + +# takes a Crypt::OpenSSL::Bignum, returns an MPI packed in preparation +# for an OpenSSH-style public key format. see: +# http://marc.info/?l=openssh-unix-dev&m=121866301718839&w=2 +sub openssh_mpi_pack { + my $num = shift; + + my $val = $num->to_bin(); + my $mpilen = length($val); + + my $ret = pack('N', $mpilen); + + # if the first bit of the leading byte is high, we should include a + # 0 byte: + if (ord($val) & 0x80) { + $ret = pack('NC', $mpilen+1, 0); + } + + return $ret.$val; +} + +sub openssh_pubkey_pack { + my $key = shift; + + my ($modulus, $exponent) = $key->get_key_parameters(); + + return openssh_mpi_pack(Crypt::OpenSSL::Bignum->new_from_bin("ssh-rsa")). + openssh_mpi_pack($exponent). + openssh_mpi_pack($modulus); +} + +# pull an OpenPGP-specified MPI off of a given stream, returning it as +# a Crypt::OpenSSL::Bignum. +sub read_mpi { + my $instr = shift; + my $readtally = shift; + + my $bitlen; + read($instr, $bitlen, 2) or die "could not read MPI length.\n"; + $bitlen = unpack('n', $bitlen); + $$readtally += 2; + + my $bytestoread = POSIX::floor(($bitlen + 7)/8); + my $ret; + read($instr, $ret, $bytestoread) or die "could not read MPI body.\n"; + $$readtally += $bytestoread; + return Crypt::OpenSSL::Bignum->new_from_bin($ret); +} + + +# FIXME: genericize these to accept either RSA or DSA keys: +sub make_rsa_pub_key_body { + my $key = shift; + my $timestamp = shift; + + my ($n, $e) = $key->get_key_parameters(); + + return + pack('CN', 4, $timestamp). + pack('C', $asym_algos->{rsa}). + mpi_pack($n). + mpi_pack($e); +} + +sub make_rsa_sec_key_body { + my $key = shift; + my $timestamp = shift; + + # we're not using $a and $b, but we need them to get to $c. + my ($n, $e, $d, $p, $q) = $key->get_key_parameters(); + + my $c3 = modular_multi_inverse($p, $q); + + my $secret_material = mpi_pack($d). + mpi_pack($p). + mpi_pack($q). + mpi_pack($c3); + + # according to Crypt::OpenSSL::RSA, the closest value we can get out + # of get_key_parameters is 1/q mod p; but according to sec 5.5.3 of + # RFC 4880, we're actually looking for u, the multiplicative inverse + # of p, mod q. This is why we're calculating the value directly + # with modular_multi_inverse. + + return + pack('CN', 4, $timestamp). + pack('C', $asym_algos->{rsa}). + mpi_pack($n). + mpi_pack($e). + pack('C', 0). # seckey material is not encrypted -- see RFC 4880 sec 5.5.3 + $secret_material. + pack('n', simple_checksum($secret_material)); +} + +# expects an RSA key (public or private) and a timestamp +sub fingerprint { + my $key = shift; + my $timestamp = shift; + + my $rsabody = make_rsa_pub_key_body($key, $timestamp); + + return Digest::SHA1::sha1(pack('Cn', 0x99, length($rsabody)).$rsabody); +} + + +# FIXME: handle DSA keys as well! +sub pem2openpgp { + my $rsa = shift; + my $uid = shift; + my $args = shift; + + $rsa->use_sha1_hash(); + + # see page 22 of RFC 4880 for why i think this is the right padding + # choice to use: + $rsa->use_pkcs1_padding(); + + if (! $rsa->check_key()) { + die "key does not check"; + } + + my $version = pack('C', 4); + # strong assertion of identity: + my $sigtype = pack('C', $sig_types->{positive_certification}); + # RSA + my $pubkey_algo = pack('C', $asym_algos->{rsa}); + # SHA1 + my $hash_algo = pack('C', $digests->{sha1}); + + # FIXME: i'm worried about generating a bazillion new OpenPGP + # certificates from the same key, which could easily happen if you run + # this script more than once against the same key (because the + # timestamps will differ). How can we prevent this? + + # this environment variable (if set) overrides the current time, to + # be able to create a standard key? If we read the key from a file + # instead of stdin, should we use the creation time on the file? + my $timestamp = 0; + if (defined $args->{timestamp}) { + $timestamp = ($args->{timestamp} + 0); + } else { + $timestamp = time(); + } + + my $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $timestamp); + + + my $flags = 0; + if (! defined $args->{usage_flags}) { + $flags = $usage_flags->{certify}; + } else { + my @ff = split(",", $args->{usage_flags}); + foreach my $f (@ff) { + if (! defined $usage_flags->{$f}) { + die "No such flag $f"; + } + $flags |= $usage_flags->{$f}; + } + } + + my $usage_packet = pack('CCC', 2, $subpacket_types->{usage_flags}, $flags); + + + # how should we determine how far off to set the expiration date? + # default is no expiration. Specify the timestamp in seconds from the + # key creation. + my $expiration_packet = ''; + if (defined $args->{expiration}) { + my $expires_in = $args->{expiration} + 0; + $expiration_packet = pack('CCN', 5, $subpacket_types->{key_expiration_time}, $expires_in); + } + + + # prefer AES-256, AES-192, AES-128, CAST5, 3DES: + my $pref_sym_algos = pack('CCCCCCC', 6, $subpacket_types->{preferred_cipher}, + $ciphers->{aes256}, + $ciphers->{aes192}, + $ciphers->{aes128}, + $ciphers->{cast5}, + $ciphers->{tripledes} + ); + + # prefer SHA-1, SHA-256, RIPE-MD/160 + my $pref_hash_algos = pack('CCCCC', 4, $subpacket_types->{preferred_digest}, + $digests->{sha1}, + $digests->{sha256}, + $digests->{ripemd160} + ); + + # prefer ZLIB, BZip2, ZIP + my $pref_zip_algos = pack('CCCCC', 4, $subpacket_types->{preferred_compression}, + $zips->{zlib}, + $zips->{bzip2}, + $zips->{zip} + ); + + # we support the MDC feature: + my $feature_subpacket = pack('CCC', 2, $subpacket_types->{features}, + $features->{mdc}); + + # keyserver preference: only owner modify (???): + my $keyserver_pref = pack('CCC', 2, $subpacket_types->{keyserver_prefs}, + $keyserver_prefs->{nomodify}); + + my $subpackets_to_be_hashed = + $creation_time_packet. + $usage_packet. + $expiration_packet. + $pref_sym_algos. + $pref_hash_algos. + $pref_zip_algos. + $feature_subpacket. + $keyserver_pref; + + my $subpacket_octets = pack('n', length($subpackets_to_be_hashed)); + + my $sig_data_to_be_hashed = + $version. + $sigtype. + $pubkey_algo. + $hash_algo. + $subpacket_octets. + $subpackets_to_be_hashed; + + my $pubkey = make_rsa_pub_key_body($rsa, $timestamp); + my $seckey = make_rsa_sec_key_body($rsa, $timestamp); + + # this is for signing. it needs to be an old-style header with a + # 2-packet octet count. + + my $key_data = make_packet($packet_types->{pubkey}, $pubkey, {'packet_length'=>2}); + + # take the last 8 bytes of the fingerprint as the keyid: + my $keyid = substr(fingerprint($rsa, $timestamp), 20 - 8, 8); + + # the v4 signature trailer is: + + # version number, literal 0xff, and then a 4-byte count of the + # signature data itself. + my $trailer = pack('CCN', 4, 0xff, length($sig_data_to_be_hashed)); + + my $uid_data = + pack('CN', 0xb4, length($uid)). + $uid; + + my $datatosign = + $key_data. + $uid_data. + $sig_data_to_be_hashed. + $trailer; + + my $data_hash = Digest::SHA1::sha1_hex($datatosign); + + my $issuer_packet = pack('CCa8', 9, $subpacket_types->{issuer}, $keyid); + + my $sig = Crypt::OpenSSL::Bignum->new_from_bin($rsa->sign($datatosign)); + + my $sig_body = + $sig_data_to_be_hashed. + pack('n', length($issuer_packet)). + $issuer_packet. + pack('n', hex(substr($data_hash, 0, 4))). + mpi_pack($sig); + + return + make_packet($packet_types->{seckey}, $seckey). + make_packet($packet_types->{uid}, $uid). + make_packet($packet_types->{sig}, $sig_body); +} + + +sub openpgp2ssh { + my $instr = shift; + my $fpr = shift; + + if (defined $fpr) { + if (length($fpr) < 8) { + die "We need at least 8 hex digits of fingerprint.\n"; + } + $fpr = uc($fpr); + } + + my $packettag; + my $dummy; + my $tag; + + my $key; + + while (! eof($instr)) { + read($instr, $packettag, 1); + $packettag = ord($packettag); + + my $packetlen; + if ( ! (0x80 & $packettag)) { + die "This is not an OpenPGP packet\n"; + } + if (0x40 & $packettag) { + $tag = (0x3f & $packettag); + my $nextlen = 0; + read($instr, $nextlen, 1); + $nextlen = ord($nextlen); + if ($nextlen < 192) { + $packetlen = $nextlen; + } elsif ($nextlen < 224) { + my $newoct; + read($instr, $newoct, 1); + $newoct = ord($newoct); + $packetlen = (($nextlen - 192) << 8) + ($newoct) + 192; + } elsif ($nextlen == 255) { + read($instr, $nextlen, 4); + $packetlen = unpack('N', $nextlen); + } else { + # packet length is undefined. + } + } else { + my $lentype; + $lentype = 0x03 & $packettag; + $tag = ( 0x3c & $packettag ) >> 2; + if ($lentype == 0) { + read($instr, $packetlen, 1) or die "could not read packet length\n"; + $packetlen = unpack('C', $packetlen); + } elsif ($lentype == 1) { + read($instr, $packetlen, 2) or die "could not read packet length\n"; + $packetlen = unpack('n', $packetlen); + } elsif ($lentype == 2) { + read($instr, $packetlen, 4) or die "could not read packet length\n"; + $packetlen = unpack('N', $packetlen); + } else { + # packet length is undefined. + } + } + + if (! defined($packetlen)) { + die "Undefined packet lengths are not supported.\n"; + } + + if ($tag == $packet_types->{pubkey} || + $tag == $packet_types->{pub_subkey} || + $tag == $packet_types->{seckey} || + $tag == $packet_types->{sec_subkey}) { + my $ver; + my $readbytes = 0; + read($instr, $ver, 1) or die "could not read key version\n"; + $readbytes += 1; + $ver = ord($ver); + + if ($ver != 4) { + printf(STDERR "We only work with version 4 keys. This key appears to be version %s.\n", $ver); + read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n"; + } else { + + my $timestamp; + read($instr, $timestamp, 4) or die "could not read key timestamp.\n"; + $readbytes += 4; + $timestamp = unpack('N', $timestamp); + + my $algo; + read($instr, $algo, 1) or die "could not read key algorithm.\n"; + $readbytes += 1; + $algo = ord($algo); + if ($algo != $asym_algos->{rsa}) { + printf(STDERR "We only support RSA keys (this key used algorithm %d).\n", $algo); + read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n"; + } else { + ## we have an RSA key. + my $modulus = read_mpi($instr, \$readbytes); + my $exponent = read_mpi($instr, \$readbytes); + + my $pubkey = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus, $exponent); + my $foundfpr = fingerprint($pubkey, $timestamp); + + my $foundfprstr = Crypt::OpenSSL::Bignum->new_from_bin($foundfpr)->to_hex(); + + # is this a match? + if ((!defined($fpr)) || + (substr($foundfprstr, -1 * length($fpr)) eq $fpr)) { + if (defined($key)) { + die "Found two matching keys.\n"; + } + $key = $pubkey; + } + + if ($tag == $packet_types->{seckey} || + $tag == $packet_types->{sec_subkey}) { + if (!defined($key)) { # we don't think the public part of + # this key matches + read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n"; + } else { + my $s2k; + read($instr, $s2k, 1) or die "Could not read S2K octet.\n"; + $readbytes += 1; + $s2k = ord($s2k); + if ($s2k == 0) { + # secret material is unencrypted + # see http://tools.ietf.org/html/rfc4880#section-5.5.3 + my $d = read_mpi($instr, \$readbytes); + my $p = read_mpi($instr, \$readbytes); + my $q = read_mpi($instr, \$readbytes); + my $u = read_mpi($instr, \$readbytes); + + my $checksum; + read($instr, $checksum, 2) or die "Could not read checksum of secret key material.\n"; + $readbytes += 2; + $checksum = unpack('n', $checksum); + + # FIXME: compare with the checksum! how? the data is + # gone into the Crypt::OpenSSL::Bignum + + $key = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus, + $exponent, + $d, + $p, + $q); + + $key->check_key() or die "Secret key is not a valid RSA key.\n"; + } else { + print(STDERR "We cannot handle encrypted secret keys. Skipping!\n") ; + read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n"; + } + } + } + + } + } + } else { + read($instr, $dummy, $packetlen) or die "Could not skip past this packet!\n"; + } + } + + return $key; +} + + +for (basename($0)) { + if (/^pem2openpgp$/) { + my $rsa; + my $stdin; + + my $uid = shift; + defined($uid) or die "You must specify a user ID string.\n"; + + # FIXME: fail if there is no given user ID; or should we default to + # hostname_long() from Sys::Hostname::Long ? + + + if (defined $ENV{PEM2OPENPGP_NEWKEY}) { + $rsa = Crypt::OpenSSL::RSA->generate_key($ENV{PEM2OPENPGP_NEWKEY}); + } else { + $stdin = do { + local $/; # slurp! + ; + }; + + $rsa = Crypt::OpenSSL::RSA->new_private_key($stdin); + } + + print pem2openpgp($rsa, + $uid, + { timestamp => $ENV{PEM2OPENPGP_TIMESTAMP}, + expiration => $ENV{PEM2OPENPGP_EXPIRATION}, + usage_flags => $ENV{PEM2OPENPGP_USAGE_FLAGS}, + } + ); + } + elsif (/^openpgp2ssh$/) { + my $fpr = shift; + my $instream; + open($instream,'-'); + binmode($instream, ":bytes"); + my $key = openpgp2ssh($instream, $fpr); + if (defined($key)) { + if ($key->is_private()) { + print $key->get_private_key_string(); + } else { + print "ssh-rsa ".encode_base64(openssh_pubkey_pack($key), '')."\n"; + } + } else { + die "No matching key found.\n"; + } + } + else { + die "Unrecognized keytrans call.\n"; + } +} + -- cgit v1.2.3