X-Git-Url: https://codewiz.org/gitweb?a=blobdiff_plain;f=src%2Fkeytrans%2Fpem2openpgp;h=40188c7ab64dbb7b9224ffd4e50de376dd97bc7d;hb=b62cb24951ccb9026fa9c2d660398be094a8b62f;hp=8ef6257a6724072b869cddee1be64a781175cc98;hpb=c18ef1a9a630826e642f33a7077b382cc5a7a25c;p=monkeysphere.git

diff --git a/src/keytrans/pem2openpgp b/src/keytrans/pem2openpgp
index 8ef6257..40188c7 100755
--- a/src/keytrans/pem2openpgp
+++ b/src/keytrans/pem2openpgp
@@ -23,6 +23,7 @@
 
 use strict;
 use warnings;
+use File::Basename;
 use Crypt::OpenSSL::RSA;
 use Crypt::OpenSSL::Bignum;
 use Crypt::OpenSSL::Bignum::CTX;
@@ -32,12 +33,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 +185,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 +216,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 +232,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 = '';
   }
 
@@ -266,6 +288,51 @@ sub mpi_pack {
   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 $bitlen;
+  read($instr, $bitlen, 2) or die "could not read MPI length.\n";
+  $bitlen = unpack('n', $bitlen);
+
+  my $ret;
+  read($instr, $ret, ($bitlen + 7)/8) or die "could not read MPI body.\n";
+  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;
@@ -287,10 +354,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,169 +387,333 @@ 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 = <STDIN>;
 
+# 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";
-}
-
-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 = 0;
-if (defined $ENV{PEM2OPENPGP_TIMESTAMP}) {
-  $timestamp = ($ENV{PEM2OPENPGP_TIMESTAMP} + 0);
-} else {
-  $timestamp = time();
-}
-
-my $flags = 0;
-if (! defined $ENV{PEM2OPENPGP_USAGE_FLAGS}) {
-  $flags = $usage_flags->{authenticate};
-} else {
-  my @ff = split(",", $ENV{PEM2OPENPGP_USAGE_FLAGS});
-  foreach my $f (@ff) {
-    if (! defined $usage_flags->{$f})
-      die "No such flag $f";
-    $flags |= $usage_flags->{$f};
+  if (! $rsa->check_key()) {
+    die "key does not check";
   }
-}
-
-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 $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 $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 $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $timestamp);
 
-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 $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 $pubkey = make_rsa_pub_key_body($rsa, $timestamp);
-my $seckey = make_rsa_sec_key_body($rsa, $timestamp);
+  my $usage_packet = pack('CCC', 2, $subpacket_types->{usage_flags}, $flags);
 
-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);
+  # 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);
+  }
 
-# 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));
+  # 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);
 
-my $uid_data =
-  pack('CN', 0xb4, length($uid)).
-  $uid;
+  return
+    make_packet($packet_types->{seckey}, $seckey).
+      make_packet($packet_types->{uid}, $uid).
+	make_packet($packet_types->{sig}, $sig_body);
+}
 
-my $datatosign =
-  $key_data.
-  $uid_data.
-  $sig_data_to_be_hashed.
-  $trailer;
 
-my $data_hash = Digest::SHA1::sha1_hex($datatosign);
+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";
+    }
+  }
 
-my $issuer_packet = pack('CCa8', 9, $subpacket_types->{issuer}, $keyid);
+  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;
+      read($instr, $ver, 1) or die "could not read key version\n";
+      $ver = ord($ver);
+      if ($ver != 4) {
+	printf(STDERR "We only work with version 4 keys.  This key appears to be version $ver.\n");
+	read($instr, $dummy, $packetlen - 1) or die "Could not skip past this packet.\n";
+      } else {
+
+	my $timestamp;
+	read($instr, $timestamp, 4) or die "could not read key timestamp.\n";
+	$timestamp = unpack('N', $timestamp);
+
+	my $algo;
+	read($instr, $algo, 1) or die "could not read key algorithm.\n";
+	$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 - 6) or die "Could not skip past this packet.\n";
+	} else {
+	  ## we have an RSA key.
+	  my $modulus = read_mpi($instr);
+	  my $exponent = read_mpi($instr);
+
+	  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}) {
+	    die "Cannot deal with secret keys yet!\n";
+	  }
+
+	}
+      }
+    } else {
+      read($instr, $dummy, $packetlen) or die "Could not skip past this packet!\n";
+    }
+  }
 
-my $sig = Crypt::OpenSSL::Bignum->new_from_bin($rsa->sign($datatosign));
+  if (defined($key)) {
+    return "ssh-rsa ".encode_base64(openssh_pubkey_pack($key), '');
+  }
+}
 
-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);
 
+for (basename($0)) {
+  if (/^pem2openpgp$/) {
+    my $rsa;
+    my $stdin;
+    if (defined $ENV{PEM2OPENPGP_NEWKEY}) {
+      $rsa = Crypt::OpenSSL::RSA->generate_key($ENV{PEM2OPENPGP_NEWKEY});
+    } else {
+      $stdin = do {
+	local $/; # slurp!
+	<STDIN>;
+      };
+
+      $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},
+		      }
+		     );
+  }
+  elsif (/^openpgp2ssh$/) {
+      my $fpr = shift;
+      my $instream;
+      open($instream,'-');
+      binmode($instream, ":bytes");
+      print openpgp2ssh($instream, $fpr);
+  }
+  else {
+    die "Unrecognized keytrans call.\n";
+  }
+}