X-Git-Url: https://codewiz.org/gitweb?a=blobdiff_plain;f=src%2Fkeytrans%2Fpem2openpgp;h=4e6ebe71a21f47d5ab7bfe4d3d6e3d94dc60e5e2;hb=b08a2e207f22000b494fc1aabe413bea5eb8f7d5;hp=3d9f6f83eb34cc43fdac303891c45194d7a15bf5;hpb=c066aca91e4e9595bb0c709673dfc5a51666b4c9;p=monkeysphere.git diff --git a/src/keytrans/pem2openpgp b/src/keytrans/pem2openpgp index 3d9f6f8..4e6ebe7 100755 --- a/src/keytrans/pem2openpgp +++ b/src/keytrans/pem2openpgp @@ -32,12 +32,11 @@ use MIME::Base64; ## make sure all length() and substr() calls use bytes only: use bytes; -my $uid = shift; - -# FIXME: fail if there is no given user ID; or should we default to -# hostname_long() from Sys::Hostname::Long ? - - +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, @@ -185,12 +184,18 @@ 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); @@ -210,7 +215,12 @@ sub modular_multi_inverse { die "did this math wrong.\n"; } - return $lastx; + # 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; } @@ -221,26 +231,37 @@ sub modular_multi_inverse { 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 ($len < 2**8) { - $lenbytes = 0; + if ($pseudolen < 2**8) { + $lenbytes = $old_format_packet_lengths->{one}; $lencode = 'C'; - } elsif ($len < 2**16) { - $lenbytes = 1; + } elsif ($pseudolen < 2**16) { + $lenbytes = $old_format_packet_lengths->{two}; $lencode = 'n'; - } elsif ($len < 2**31) { + } elsif ($pseudolen < 2**31) { ## not testing against full 32 bits because i don't want to deal ## with potential overflow. - $lenbytes = 2; + $lenbytes = $old_format_packet_lengths->{four}; $lencode = 'N'; } else { ## what the hell do we do here? - $lenbytes = 3; + $lenbytes = $old_format_packet_lengths->{indeterminate}; $lencode = ''; } @@ -287,10 +308,12 @@ sub make_rsa_sec_key_body { # 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(modular_multi_inverse($p, $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 @@ -318,152 +341,196 @@ sub fingerprint { return Digest::SHA1::sha1(pack('Cn', 0x99, length($rsabody)).$rsabody); } -# we're just not dealing with newline business right now. slurp in -# the whole file. -undef $/; -my $buf = ; +# FIXME: handle DSA keys as well! +sub pem2openpgp { + my $rsa = shift; + my $uid = shift; + my $args = shift; -my $rsa = Crypt::OpenSSL::RSA->new_private_key($buf); + $rsa->use_sha1_hash(); -$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(); -# 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"; + } -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 $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? - -# could an environment variable (if set) override 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 = time(); -my $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $timestamp); - - -# FIXME: HARDCODED: what if someone wants to select a different set of -# usage flags? For now, we do only authentication because that's what -# monkeysphere needs. -my $usage_packet = pack('CCC', 2, $subpacket_types->{usage_flags}, $usage_flags->{authenticate}); - - -# FIXME: HARDCODED: how should we determine how far off to set the -# expiration date? default is to expire in 2 days, which is insanely -# short (but good for testing). The user ought to be able to decide -# this directly, rather than having to do "monkeysphere-server -# extend-key". -my $expires_in = 86400*2; -my $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); - -my $key_data = make_packet($packet_types->{pubkey}, $pubkey); - -# 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 $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 $issuer_packet = pack('CCa8', 9, $subpacket_types->{issuer}, $keyid); - -my $sig = Crypt::OpenSSL::Bignum->new_from_bin($rsa->sign($datatosign)); +my $uid = shift; -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); - -print - make_packet($packet_types->{seckey}, $seckey). - make_packet($packet_types->{uid}, $uid). - make_packet($packet_types->{sig}, $sig_body); +# 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}, + } + );