handle revoker packets (rvk)

8 files changed, 204 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index 12ea121..c49859d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,6 +21,7 @@ lib/GnuPG/Signature.pm
 lib/GnuPG/SubKey.pm
 lib/GnuPG/UserId.pm
 lib/GnuPG/UserAttribute.pm
+lib/GnuPG/Revoker.pm
 Makefile.PL
 MANIFEST			This list of files
 MANIFEST.SKIP
diff --git a/lib/GnuPG/Interface.pm b/lib/GnuPG/Interface.pm
index 75b5ae1..b7e82c3 100644
--- a/lib/GnuPG/Interface.pm
+++ b/lib/GnuPG/Interface.pm
@@ -408,6 +408,7 @@ sub get_keys {
     require GnuPG::UserId;
     require GnuPG::UserAttribute;
     require GnuPG::Signature;
+    require GnuPG::Revoker;
 
     while (<$stdout>) {
         my $line = $_;
@@ -505,6 +506,7 @@ sub get_keys {
 
             if ( $current_signed_item->isa('GnuPG::Key') ||
                  $current_signed_item->isa('GnuPG::UserId') ||
+                 $current_signed_item->isa('GnuPG::Revoker') ||
                  $current_signed_item->isa('GnuPG::UserAttribute')) {
               if ($record_type eq 'sig') {
                 $current_signed_item->push_signatures($signature);
@@ -571,6 +573,19 @@ sub get_keys {
 
             $current_primary_key->push_subkeys($current_signed_item);
         }
+        elsif ($record_type eq 'rvk') {
+          my ($algo_num, $fpr, $class) = @fields[ 3,9,10 ];
+          my $rvk = GnuPG::Revoker->new(
+           fingerprint => GnuPG::Fingerprint->new( as_hex_string => $fpr ),
+           algo_num    => ($algo_num + 0),
+           class       => hex($class),
+          );
+          # pushing to either primary key or subkey, to handle
+          # designated revokers to the subkeys too:
+          $current_key->push_revokers($rvk);
+          # revokers should be bound to the key with signatures:
+          $current_signed_item = $rvk;
+        }
         elsif ( $record_type ne 'tru' ) {
             warn "unknown record type $record_type";
         }
diff --git a/lib/GnuPG/Key.pm b/lib/GnuPG/Key.pm
index 1b0ee1a..cfe9fb8 100644
--- a/lib/GnuPG/Key.pm
+++ b/lib/GnuPG/Key.pm
@@ -56,6 +56,17 @@ sub push_revocations {
     push @{ $self->revocations }, @_;
 }
 
+has revokers => (
+    isa       => 'ArrayRef',
+    is        => 'rw',
+    default   => sub { [] },
+);
+
+sub push_revokers {
+    my $self = shift;
+    push @{ $self->revokers }, @_;
+}
+
 sub short_hex_id {
     my ($self) = @_;
     return substr $self->hex_id(), -8;
@@ -173,10 +184,18 @@ GnuPG::Signature objects (since revocations are a type of
 certification as well).  Note that a revocation of a primary key has a
 different semantic meaning than a revocation associated with a subkey.
 
+=item revokers
+
+A list of GnuPG::Revoker objects associated with this key, indicating
+other keys which are allowed to revoke certifications made by this
+key.
+
 =back
 
 =head1 SEE ALSO
 
 L<GnuPG::Fingerprint>,
+L<GnuPG::Signature>,
+L<GnuPG::Revoker>,
 
 =cut
diff --git a/lib/GnuPG/Revoker.pm b/lib/GnuPG/Revoker.pm
new file mode 100644
index 0000000..e688d3e
--- /dev/null
+++ b/lib/GnuPG/Revoker.pm
@@ -0,0 +1,145 @@
+#  Revoker.pm
+#    - providing an object-oriented approach to GnuPG key revokers
+#
+#  Copyright (C) 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+#  (derived from Signature.pm, Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>)
+#
+#  This module is free software; you can redistribute it and/or modify it
+#  under the same terms as Perl itself.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#  $Id: Signature.pm,v 1.4 2001/08/21 13:31:50 ftobin Exp $
+#
+
+package GnuPG::Revoker;
+use Any::Moose;
+
+has [qw(
+         algo_num
+         class
+      )] => (
+    isa => 'Int',
+    is  => 'rw',
+);
+
+has fingerprint => (
+                    isa => 'GnuPG::Fingerprint',
+                    is => 'rw',
+                    );
+
+has signatures => (
+    isa       => 'ArrayRef',
+    is        => 'rw',
+    default   => sub { [] },
+);
+
+sub push_signatures {
+    my $self = shift;
+    push @{ $self->signatures }, @_;
+}
+
+sub is_sensitive {
+    my $self = shift;
+    return $self->class & 0x40;
+}
+
+sub compare {
+  my ( $self, $other, $deep ) = @_;
+
+  my @comparison_ints = qw( class algo_num );
+
+  foreach my $field ( @comparison_ints ) {
+    return 0 unless $self->$field() == $other->$field();
+  }
+
+  return 0 unless $self->fingerprint->compare($other->fingerprint);
+
+  if ($deep) {
+    for ( my $i = 0; $i < scalar(@{$self->signatures}); $i++ ) {
+      return 0
+        unless $self->signatures->[$i]->compare($other->signatures->[$i], 1);
+    }
+  }
+
+  return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+GnuPG::Revoker - GnuPG Key Revoker Objects
+
+=head1 SYNOPSIS
+
+  # assumes a GnuPG::PrimaryKey object in $key
+  my $revokerfpr = $key->revokers->[0]->fingerprint();
+
+=head1 DESCRIPTION
+
+GnuPG::Revoker objects are generally not instantiated on their own,
+but rather as part of GnuPG::Key objects.  They represent a statement
+that another key is designated to revoke certifications made by the
+key in question.
+
+=head1 OBJECT METHODS
+
+=over 4
+
+=item new( I<%initialization_args> )
+
+This methods creates a new object.  The optional arguments are
+initialization of data members.
+
+=item is_sensitive()
+
+Returns 0 if the revoker information can be freely distributed.
+If this is non-zero, the information should be treated as "sensitive".
+
+Please see http://tools.ietf.org/html/rfc4880#section-5.2.3.15 for
+more explanation.
+
+=back
+
+=head1 OBJECT DATA MEMBERS
+
+=over 4
+
+=item fingerprint
+
+A GnuPG::Fingerprint object indicating the fingerprint of the
+specified revoking key.  (Note that this is *not* the fingerprint of
+the key whose signatures can be revoked by this revoker).
+
+=item algo_num
+
+The numeric identifier of the algorithm of the revoker's key.
+
+=item signatures
+
+A list of GnuPG::Signature objects which cryptographically bind the
+designated revoker to the primary key.  A valid revoker designation
+should always have a valid signature associated with it from the
+relevant key doing the designation (not from the revoker's key).
+
+Note that designated revoker certifications are themselves
+irrevocable, so there is no analogous list of revocations in a
+GnuPG::Revoker object.
+
+=back
+
+=head1 SEE ALSO
+
+L<GnuPG::Fingerprint>,
+L<GnuPG::Key>,
+L<GnuPG::Signature>,
+L<http://tools.ietf.org/html/rfc4880#section-5.2.3.15>
+
+=cut
diff --git a/t/GnuPG/ComparableKey.pm b/t/GnuPG/ComparableKey.pm
index 46749c8..61f9d53 100644
--- a/t/GnuPG/ComparableKey.pm
+++ b/t/GnuPG/ComparableKey.pm
@@ -60,6 +60,11 @@ sub _deeply_compare
         unless $self->revocations->[$i]->compare($other->revocations->[$i], 1);
     }
 
+    for ( $i = 0; $i < scalar(@{$self->revokers}); $i++ ) {
+      return 0
+        unless $self->revokers->[$i]->compare($other->revokers->[$i], 1);
+    }
+
     bless $self->fingerprint(), 'GnuPG::Fingerprint';
     return ( $self->fingerprint->compare( $other->fingerprint() ) );
 }
diff --git a/t/get_public_keys.t b/t/get_public_keys.t
index ddd1562..3dffe8c 100644
--- a/t/get_public_keys.t
+++ b/t/get_public_keys.t
@@ -69,6 +69,24 @@ TEST
 	date_string    => '2000-03-16',
 	);
     
+    my $designated_revoker_sig = GnuPG::Signature->new
+      ( validity       => '!',
+        algo_num       => 17,
+	hex_id         => '53AE596EF950DA9C',
+        date           => 978325209,
+	date_string    => '2001-01-01',
+        sig_class      => 0x1f,
+        is_exportable  => 1
+	);
+
+    my $revoker = GnuPG::Revoker->new
+      ( algo_num       => 17,
+        class          => 0x80,
+	fingerprint    => GnuPG::Fingerprint->new( as_hex_string =>
+                                                   '4F863BBBA8166F0A340F600356FFD10A260C4FA3'),
+	);
+    $revoker->push_signatures($designated_revoker_sig);
+    
     my $subkey = GnuPG::SubKey->new
       ( validity                 => 'u',
 	length                   => 768,
@@ -89,6 +107,7 @@ TEST
     $subkey->push_signatures( $subkey_signature );
     
     $handmade_key->push_subkeys( $subkey );
+    $handmade_key->push_revokers( $revoker );
     
     $handmade_key->compare( $given_key );
 };
diff --git a/test/pubring.gpg b/test/pubring.gpg
index c6d2276..60b008a 100644
--- a/test/pubring.gpg
+++ b/test/pubring.gpg
diff --git a/test/secring.gpg b/test/secring.gpg
index 391bd39..aa34674 100644
--- a/test/secring.gpg
+++ b/test/secring.gpg