+# 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";
+
+ read($instr, $dummy, $packetlen);
+ $data->{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 revuid on anything other than a signature packet.";
+
+ if ((undef $data->{key}) ||
+ (undef $data->{uid}) ||
+ ($data->{uid} ne $data->{target}->{uid})) {
+ # this is not the user ID we are looking for.
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ }
+
+ my $data;
+ read($instr, $data, 6) or die "could not read signature header\n";
+ my ($ver, $sigtype, $pubkeyalgo, $digestalgo, $subpacketsize) = unpack('CCCCn', $data);
+ if ($ver != 4) {
+ printf(STDERR "We only work with version 4 signatures.");
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ return;
+ }
+ if ($pubkeyalgo != $asym_algos->{rsa}) {
+ printf(STDERR "We can only work with RSA at the moment");
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ return;
+ }
+ if ($sigtype != $sig_types->{positive_certification}) {
+ # FIXME: some weird implementations might have made generic,
+ # persona, or casual certifications instead of positive
+ # certifications for self-sigs. Probably should handle them too.
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ return;
+ }
+
+ my $subpackets;
+ read($instr, $subpackets, $subpacketsize) or die "could not read hashed signature subpackets.\n";
+
+ read($instr, $subpacketsize, 2) or die "could not read unhashed signature subpacket size.\n";
+ $subpacketsize = unpack('n', $subpacketsize);
+
+ my $unhashedsubpackets;
+ read($instr, $unhashedsubpackets, $subpacketsize) or die "could not read unhashed signature subpackets.\n";
+
+ my $hashtail;
+ read($instr, $hashtail, 2) or die "could not read left 16 bits of digest.\n";
+
+ # RSA signatures should read in how many MPIs?
+
+
+ # reason for revocation
+
+ # non-revocable
+
+}
+
+# FIXME: to do in order to generate a proper revocation certificate:
+# parse subpackets
+
+
+# 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)
+sub findkey {
+ my $data = shift;
+ my $instr = shift;
+ my $tag = shift;
+ my $packetlen = shift;
+
+ my $dummy;
+ 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";
+ return;
+ }
+
+ my $key_timestamp;
+ read($instr, $key_timestamp, 4) or die "could not read key timestamp.\n";
+ $readbytes += 4;
+ $key_timestamp = unpack('N', $key_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";
+ return;
+ }
+
+ ## 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, $key_timestamp);
+
+ my $foundfprstr = Crypt::OpenSSL::Bignum->new_from_bin($foundfpr)->to_hex();
+ # left-pad with 0's to bring up to full 40-char (160-bit) fingerprint:
+ $foundfprstr = sprintf("%040s", $foundfprstr);
+
+ # is this a match?
+ 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;
+ }
+
+ if ($tag != $packet_types->{seckey} &&
+ $tag != $packet_types->{sec_subkey}) {
+ if ($readbytes < $packetlen) {
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ }
+ return;
+ }
+ 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";
+ }
+ return;
+ }
+
+ my $s2k;
+ read($instr, $s2k, 1) or die "Could not read S2K octet.\n";
+ $readbytes += 1;
+ $s2k = ord($s2k);
+ if ($s2k != 0) {
+ printf(STDERR "We cannot handle encrypted secret keys. Skipping!\n") ;
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ return;
+ }
+
+ # 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
+
+ $data->{key} = 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";
+
+ if ($readbytes < $packetlen) {
+ read($instr, $dummy, $packetlen - $readbytes) or die "Could not skip past this packet.\n";
+ }
+}