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/keytrans/pem2openpgp | 775 ----------------------------------------------- 1 file changed, 775 deletions(-) delete mode 100755 src/keytrans/pem2openpgp (limited to 'src/keytrans/pem2openpgp') diff --git a/src/keytrans/pem2openpgp b/src/keytrans/pem2openpgp deleted file mode 100755 index 8bf17fb..0000000 --- a/src/keytrans/pem2openpgp +++ /dev/null @@ -1,775 +0,0 @@ -#!/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