X-Git-Url: https://codewiz.org/gitweb?a=blobdiff_plain;f=src%2Fshare%2Fkeytrans;h=ae4fb0993980afb1de16558a227775486ab89b5e;hb=d4d10f1f8ae42f9e9d81aabc5814aeeeb52aaa19;hp=591cb9d580454cd26e512029713f1111b4d889e5;hpb=a6a217b5475f3e4e91706f57c26fc36497b545e1;p=monkeysphere.git

diff --git a/src/share/keytrans b/src/share/keytrans
index 591cb9d..ae4fb09 100755
--- a/src/share/keytrans
+++ b/src/share/keytrans
@@ -152,6 +152,14 @@ my $sig_types = { binary_doc => 0x00,
 		};
 
 
+# see RFC 4880 section 5.2.3.23
+my $revocation_reasons = { no_reason_specified => 0,
+			   key_superseded => 1,
+			   key_compromised => 2,
+			   key_retired => 3,
+			   user_id_no_longer_valid => 32,
+			 };
+
 # see RFC 4880 section 5.2.3.1
 my $subpacket_types = { sig_creation_time => 2,
 			sig_expiration_time => 3,
@@ -421,59 +429,24 @@ sub fingerprint {
 
 
 # FIXME: handle DSA keys as well!
-sub pem2openpgp {
+sub makeselfsig {
   my $rsa = shift;
   my $uid = shift;
   my $args = shift;
 
-  $rsa->use_sha256_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";
-  }
-
   # strong assertion of identity is the default (for a self-sig):
-  my $certtype = $sig_types->{positive_certification};
-  if (defined $args->{certification_type}) {
-    $certtype = $args->{certification_type} + 0;
+  if (! defined $args->{certification_type}) {
+    $args->{certification_type} = $sig_types->{positive_certification};
   }
 
-  my $version = pack('C', 4);
-  my $sigtype = pack('C', $certtype);
-  # RSA
-  my $pubkey_algo = pack('C', $asym_algos->{rsa});
-  # SHA256
-  my $hash_algo = pack('C', $digests->{sha256});
-
-  # 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 argument (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 $sig_timestamp = 0;
-  if (defined $args->{sig_timestamp}) {
-    $sig_timestamp = ($args->{sig_timestamp} + 0);
-  } else {
-    $sig_timestamp = time();
-  }
-  my $key_timestamp = $sig_timestamp;
-  if (defined $args->{key_timestamp}) {
-    $key_timestamp = ($args->{key_timestamp} + 0);
-  }
-  if ($key_timestamp > $sig_timestamp) {
-    die "key timestamp must not be later than signature timestamp";
+  if (! defined $args->{sig_timestamp}) {
+    $args->{sig_timestamp} = time();
   }
+  my $key_timestamp = $args->{key_timestamp} + 0;
 
-  my $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $sig_timestamp);
-
+  # generate and aggregate subpackets:
 
+  # key usage flags:
   my $flags = 0;
   if (! defined $args->{usage_flags}) {
     $flags = $usage_flags->{certify};
@@ -486,17 +459,15 @@ sub pem2openpgp {
       $flags |= $usage_flags->{$f};
     }
   }
-
-  my $usage_packet = pack('CCC', 2, $subpacket_types->{usage_flags}, $flags);
-
+  my $usage_subpacket = 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 = '';
+  my $expiration_subpacket = '';
   if (defined $args->{expiration}) {
     my $expires_in = $args->{expiration} + 0;
-    $expiration_packet = pack('CCN', 5, $subpacket_types->{key_expiration_time}, $expires_in);
+    $expiration_subpacket = pack('CCN', 5, $subpacket_types->{key_expiration_time}, $expires_in);
   }
 
 
@@ -534,17 +505,68 @@ sub pem2openpgp {
   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.
+
+  $args->{hashed_subpackets} =
+      $usage_subpacket.
+	$expiration_subpacket.
 	  $pref_sym_algos.
 	    $pref_hash_algos.
 	      $pref_zip_algos.
 		$feature_subpacket.
 		  $keyserver_pref;
 
-  my $subpacket_octets = pack('n', length($subpackets_to_be_hashed));
+  return gensig($rsa, $uid, $args);
+}
+
+# FIXME: handle non-RSA keys
+
+# FIXME: this currently only makes self-sigs -- we should parameterize
+# it to make certifications over keys other than the issuer.
+sub gensig {
+  my $rsa = shift;
+  my $uid = shift;
+  my $args = shift;
+
+  # FIXME: allow signature creation using digests other than SHA256
+  $rsa->use_sha256_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\n";
+  }
+
+  my $certtype = $args->{certification_type} + 0;
+
+  my $version = pack('C', 4);
+  my $sigtype = pack('C', $certtype);
+  # RSA
+  my $pubkey_algo = pack('C', $asym_algos->{rsa});
+  # SHA256 FIXME: allow signature creation using digests other than SHA256
+  my $hash_algo = pack('C', $digests->{sha256});
+
+  # 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 argument (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 $sig_timestamp = ($args->{sig_timestamp} + 0);
+  my $key_timestamp = ($args->{key_timestamp} + 0);
+
+  if ($key_timestamp > $sig_timestamp) {
+    die "key timestamp must not be later than signature timestamp\n";
+  }
+
+  my $creation_time_packet = pack('CCN', 5, $subpacket_types->{sig_creation_time}, $sig_timestamp);
+
+  my $hashed_subs = $creation_time_packet.$args->{hashed_subpackets};
+
+  my $subpacket_octets = pack('n', length($hashed_subs));
 
   my $sig_data_to_be_hashed =
     $version.
@@ -552,10 +574,9 @@ sub pem2openpgp {
 	$pubkey_algo.
 	  $hash_algo.
 	    $subpacket_octets.
-	      $subpackets_to_be_hashed;
+	      $hashed_subs;
 
   my $pubkey = make_rsa_pub_key_body($rsa, $key_timestamp);
-  my $seckey = make_rsa_sec_key_body($rsa, $key_timestamp);
 
   # this is for signing.  it needs to be an old-style header with a
   # 2-packet octet count.
@@ -581,6 +602,7 @@ sub pem2openpgp {
 	$sig_data_to_be_hashed.
 	  $trailer;
 
+  # FIXME: handle signatures over digests other than SHA256:
   my $data_hash = Digest::SHA::sha256_hex($datatosign);
 
   my $issuer_packet = pack('CCa8', 9, $subpacket_types->{issuer}, $keyid);
@@ -594,15 +616,64 @@ sub pem2openpgp {
 	  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);
+  return make_packet($packet_types->{sig}, $sig_body);
 }
 
 # FIXME: switch to passing the whole packet as the arg, instead of the
 # input stream.
 
+# FIXME: think about native perl representation of the packets instead.
+
+# Put a user ID into the $data
+sub finduid {
+  my $data = shift;
+  my $instr = shift;
+  my $tag = shift;
+  my $packetlen = shift;
+
+  my $dummy;
+  ($tag == $packet_types->{uid}) or die "This should not be called on anything but a User ID packet\n";
+
+  read($instr, $dummy, $packetlen);
+  $data->{uid}->{$dummy} = {};
+  $data->{current}->{uid} = $dummy;
+}
+
+
+# find signatures associated with the given fingerprint and user ID.
+sub findsig {
+  my $data = shift;
+  my $instr = shift;
+  my $tag = shift;
+  my $packetlen = shift;
+
+  ($tag == $packet_types->{sig}) or die "No calling findsig on anything other than a signature packet.\n";
+
+  my $dummy;
+  my $readbytes = 0;
+
+  read($instr, $dummy, $packetlen - $readbytes) or die "Could not read in this packet.\n";
+
+  if ((! defined $data->{key}) ||
+      (! defined $data->{uid}) ||
+      (! defined $data->{uid}->{$data->{target}->{uid}})) {
+    # the user ID we are looking for has not been found yet.
+    return;
+  }
+
+  # FIXME: if we get two primary keys on stdin, both with the same
+  # targetd user ID, we'll store signatures from both keys, which is
+  # probably wrong.
+
+  # the current ID is not what we're looking for:
+  return if ($data->{current}->{uid} ne $data->{target}->{uid});
+
+  # just storing the raw signatures for the moment:
+  push @{$data->{sigs}}, make_packet($packet_types->{sig}, $dummy);
+  return;
+
+}
+
 # given an input stream and data, store the found key in data and
 # consume the rest of the stream corresponding to the packet.
 # data contains: (fpr: fingerprint to find, key: current best guess at key)
@@ -653,12 +724,13 @@ sub findkey {
   $foundfprstr = sprintf("%040s", $foundfprstr);
 
   # is this a match?
-  if ((!defined($data->{fpr})) ||
-      (substr($foundfprstr, -1 * length($data->{fpr})) eq $data->{fpr})) {
+  if ((!defined($data->{target}->{fpr})) ||
+      (substr($foundfprstr, -1 * length($data->{target}->{fpr})) eq $data->{target}->{fpr})) {
     if (defined($data->{key})) {
       die "Found two matching keys.\n";
     }
-    $data->{key} = $pubkey;
+    $data->{key} = { 'rsa' => $pubkey,
+		     'timestamp' => $key_timestamp };
   }
 
   if ($tag != $packet_types->{seckey} &&
@@ -668,7 +740,7 @@ sub findkey {
     }
     return;
   }
-  if (!defined($data->{key})) { 
+  if (!defined($data->{key})) {
     # we don't think the public part of this key matches
     if ($readbytes < $packetlen) {
       read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
@@ -701,20 +773,20 @@ sub findkey {
   # FIXME: compare with the checksum!  how?  the data is
   # gone into the Crypt::OpenSSL::Bignum
 
-  $data->{key} = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus,
-							      $exponent,
-							      $d,
-							      $p,
-							      $q);
+  $data->{key}->{rsa} = Crypt::OpenSSL::RSA->new_key_from_parameters($modulus,
+								     $exponent,
+								     $d,
+								     $p,
+								     $q);
 
-  $data->{key}->check_key() or die "Secret key is not a valid RSA key.\n";
+  $data->{key}->{rsa}->check_key() or die "Secret key is not a valid RSA key.\n";
 
   if ($readbytes < $packetlen) {
     read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
   }
 }
 
-sub openpgp2ssh {
+sub openpgp2rsa {
   my $instr = shift;
   my $fpr = shift;
 
@@ -725,7 +797,9 @@ sub openpgp2ssh {
     $fpr = uc($fpr);
   }
 
-  my $data = { 'fpr' => $fpr};
+  my $data = { target => { fpr => $fpr,
+			 },
+	       };
   my $subs = { $packet_types->{pubkey} => \&findkey,
 	       $packet_types->{pub_subkey} => \&findkey,
 	       $packet_types->{seckey} => \&findkey,
@@ -733,9 +807,148 @@ sub openpgp2ssh {
 
   packetwalk($instr, $subs, $data);
 
-  return $data->{key};
+  return $data->{key}->{rsa};
+}
+
+sub adduserid {
+  my $instr = shift;
+  my $fpr = shift;
+  my $uid = shift;
+  my $args = shift;
+
+  if ((! defined $fpr) ||
+      (length($fpr) < 8)) {
+    die "We need at least 8 hex digits of fingerprint.\n";
+  }
+
+  $fpr = uc($fpr);
+
+  if (! defined $uid) {
+    die "No User ID defined.\n";
+  }
+
+  my $data = { target => { fpr => $fpr,
+			   uid => $uid,
+			 },
+	     };
+  my $subs = { $packet_types->{seckey} => \&findkey,
+	       $packet_types->{uid} => \&finduid,
+	       $packet_types->{sig} => \&findsig,
+	     };
+
+  packetwalk($instr, $subs, $data);
+
+  if ((! defined $data->{key}) ||
+      (! defined $data->{key}->{rsa}) ||
+      (! defined $data->{key}->{timestamp})) {
+    die "The key requested was not found.\n"
+  }
+
+  if (defined $data->{uid}->{$uid}) {
+    die "The requested User ID '$uid' is already associated with this key.\n";
+  }
+  $args->{key_timestamp} = $data->{key}->{timestamp};
+
+  return
+    make_packet($packet_types->{pubkey}, make_rsa_pub_key_body($data->{key}->{rsa}, $data->{key}->{timestamp})).
+      make_packet($packet_types->{uid}, $uid).
+	makeselfsig($data->{key}->{rsa},
+		    $uid,
+		    $args);
+
 }
 
+
+sub revokeuserid {
+  my $instr = shift;
+  my $fpr = shift;
+  my $uid = shift;
+  my $sigtime = shift;
+
+  if ((! defined $fpr) ||
+      (length($fpr) < 8)) {
+    die "We need at least 8 hex digits of fingerprint.\n";
+  }
+
+  $fpr = uc($fpr);
+
+  if (! defined $uid) {
+    die "No User ID defined.\n";
+  }
+
+  my $data = { target => { fpr => $fpr,
+			   uid => $uid,
+			 },
+	     };
+  my $subs = { $packet_types->{seckey} => \&findkey,
+	       $packet_types->{uid} => \&finduid,
+	       $packet_types->{sig} => \&findsig,
+	     };
+
+  packetwalk($instr, $subs, $data);
+
+  if ((! defined $data->{uid}) ||
+      (! defined $data->{uid}->{$uid})) {
+    die "The User ID \"$uid\" is not associated with this key";
+  }
+
+  if ((! defined $data->{key}) ||
+      (! defined $data->{key}->{rsa}) ||
+      (! defined $data->{key}->{timestamp})) {
+    die "The key requested was not found."
+  }
+
+  my $revocation_reason = 'No longer using this hostname';
+  if (defined $data->{revocation_reason}) {
+    $revocation_reason = $data->{revocation_reason};
+  }
+
+  my $rev_reason_subpkt = prefixsubpacket(pack('CC',
+					       $subpacket_types->{revocation_reason},
+					       $revocation_reasons->{user_id_no_longer_valid}).
+					  $revocation_reason);
+
+  if (! defined $sigtime) {
+    $sigtime = time();
+  }
+  # what does a signature like this look like?
+  my $args = { key_timestamp => $data->{key}->{timestamp},
+	       sig_timestamp => $sigtime,
+	       certification_type => $sig_types->{certification_revocation},
+	       hashed_subpackets => $rev_reason_subpkt,
+	     };
+
+  return
+    make_packet($packet_types->{pubkey}, make_rsa_pub_key_body($data->{key}->{rsa}, $data->{key}->{timestamp})).
+      make_packet($packet_types->{uid}, $uid).
+	join('', @{$data->{sigs}}).
+	  gensig($data->{key}->{rsa}, $uid, $args);
+}
+
+
+# see 5.2.3.1 for tips on how to calculate the length of a subpacket:
+sub prefixsubpacket {
+  my $subpacket = shift;
+
+  my $len = length($subpacket);
+  my $prefix;
+  use bytes;
+  if ($len < 192) {
+    # one byte:
+    $prefix = pack('C', $len);
+  } elsif ($len < 16576) {
+    my $in = $len - 192;
+    my $second = $in%256;
+    my $first = ($in - $second)>>8;
+    $prefix = pack('CC', $first + 192, $second)
+  } else {
+    $prefix = pack('CN', 255, $len);
+  }
+  return $prefix.$subpacket;
+}
+
+
+
 sub packetwalk {
   my $instr = shift;
   my $subs = shift;
@@ -828,10 +1041,18 @@ for (basename($0)) {
       $rsa = Crypt::OpenSSL::RSA->new_private_key($stdin);
     }
 
-    print pem2openpgp($rsa,
+    my $key_timestamp = $ENV{PEM2OPENPGP_KEY_TIMESTAMP};
+    my $sig_timestamp = $ENV{PEM2OPENPGP_TIMESTAMP};
+    $sig_timestamp = time() if (!defined $sig_timestamp);
+    $key_timestamp = $sig_timestamp if (!defined $key_timestamp);
+
+    print
+      make_packet($packet_types->{seckey}, make_rsa_sec_key_body($rsa, $key_timestamp)).
+	make_packet($packet_types->{uid}, $uid).
+	  makeselfsig($rsa,
 		      $uid,
-		      { sig_timestamp => $ENV{PEM2OPENPGP_TIMESTAMP},
-			key_timestamp => $ENV{PEM2OPENPGP_KEY_TIMESTAMP},
+		      { sig_timestamp => $sig_timestamp,
+			key_timestamp => $key_timestamp,
 			expiration => $ENV{PEM2OPENPGP_EXPIRATION},
 			usage_flags => $ENV{PEM2OPENPGP_USAGE_FLAGS},
 		      }
@@ -842,7 +1063,7 @@ for (basename($0)) {
       my $instream;
       open($instream,'-');
       binmode($instream, ":bytes");
-      my $key = openpgp2ssh($instream, $fpr);
+      my $key = openpgp2rsa($instream, $fpr);
       if (defined($key)) {
 	if ($key->is_private()) {
 	  print $key->get_private_key_string();
@@ -853,6 +1074,39 @@ for (basename($0)) {
 	die "No matching key found.\n";
       }
   }
+  elsif (/^keytrans$/) {
+    # subcommands when keytrans is invoked directly are UNSUPPORTED,
+    # UNDOCUMENTED, and WILL NOT BE MAINTAINED.
+    my $subcommand = shift;
+    for ($subcommand) {
+      if (/^revokeuserid$/) {
+	my $fpr = shift;
+	my $uid = shift;
+	my $instream;
+	open($instream,'-');
+	binmode($instream, ":bytes");
+
+	my $revcert = revokeuserid($instream, $fpr, $uid, $ENV{PEM2OPENPGP_TIMESTAMP});
+
+	print $revcert;
+      } elsif (/^adduserid$/) {
+	my $fpr = shift;
+	my $uid = shift;
+	my $instream;
+	open($instream,'-');
+	binmode($instream, ":bytes");
+	my $newuid = adduserid($instream, $fpr, $uid, 
+			       { sig_timestamp => $ENV{PEM2OPENPGP_TIMESTAMP},
+				 expiration => $ENV{PEM2OPENPGP_EXPIRATION},
+				 usage_flags => $ENV{PEM2OPENPGP_USAGE_FLAGS},
+			       });
+
+	print $newuid;
+      } else {
+	die "Unrecognized subcommand.  keytrans subcommands are not a stable interface!\n";
+      }
+    }
+  }
   else {
     die "Unrecognized keytrans call.\n";
   }