#!/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 Crypt::OpenSSL::RSA; use Crypt::OpenSSL::Bignum; use Crypt::OpenSSL::Bignum::CTX; use Digest::SHA1; use MIME::Base64; ## 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; } # 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); } my $rsa; my $stdin; 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); } my $uid = shift; # FIXME: fail if there is no given user ID; or should we default to # hostname_long() from Sys::Hostname::Long ? print pem2openpgp($rsa, $uid, { timestamp => $ENV{PEM2OPENPGP_TIMESTAMP}, expiration => $ENV{PEM2OPENPGP_EXPIRATION}, usage_flags => $ENV{PEM2OPENPGP_USAGE_FLAGS}, } );