2004 version of youam's gpgsigs tool

git-svn-id: svn://svn.debian.org/pgp-tools/trunk@39 b513b33f-fedd-0310-b452-c3deb5f4c849

diff --git a/gpgsigs/gpgsigs b/gpgsigs/gpgsigs
new file mode 100644 (file)
index 0000000..d89b1d5
--- /dev/null
+++ b/gpgsigs/gpgsigs
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+
+# Copyright (c) 2004 Uli Martens <uli@youam.net>
+# Copyright (c) 2004 Peter Palfrader <peter@palfrader.org>
+# Copyright (c) 2004 Christoph Berg <cb@df7cb.de>
+#
+# All rights reserved.
+# 
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. The name of the author may not be used to endorse or promote products
+#    derived from this software without specific prior written permission.
+# 
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+#
+#
+# Depends: 
+#         libintl-perl (Locale::Recode)
+#      OR libtext-iconv-perl (Text::Iconv),
+#      OR the "recode" binary
+
+
+use strict;
+use warnings;
+use File::Temp qw{tempdir};
+use English;
+use IPC::Open3;
+
+my $r;
+my $i;
+if (eval "require Locale::Recode") {
+       $r = Locale::Recode->new (from => 'UTF-8',
+                             to   => 'ISO-8859-1');
+} elsif (eval "require Text::Iconv") {
+       $i = Text::Iconv->new("UTF-8", "ISO-8859-1");
+}
+
+sub myrecode($) {
+       my ($text) = @_;
+       if (defined $r) {
+               my $orig = $text;
+               $r->recode($text);
+#printf STDERR "perl:  $orig to $text\n";
+               return $text;
+       } elsif (defined $i) {
+               $text = $i->convert($text);
+       } else {
+               my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', 'utf8..iso8859-1');
+               print WTRFH $text;
+               close WTRFH;
+               local $/ = undef;
+               my $result = <RDRFH>;
+               close RDRFH;
+               close ERRFH;
+               waitpid $pid, 0;
+
+               die ("'recode' failed, is it installed?\n") unless defined $result;
+#printf STDERR "manual:  $text to $result\n";
+               return $result;
+       };
+}
+
+
+my $EXPECTED_MD5 = '90 43 B8 1B';
+
+my $mykey = uc(shift @ARGV);
+my $keyring = shift @ARGV;
+my $keytxt = shift @ARGV;
+my $outfile = shift @ARGV;
+
+$keyring = 'ksp-lt2k4.asc' unless defined $keyring;
+$keytxt = 'ksp-lt2k4.txt' unless defined $keytxt;
+$outfile = 'ksp-lt2k4-annotated.txt' unless defined $outfile;
+
+if (!defined $mykey || scalar @ARGV || ($mykey !~ /^[0-9A-F]{16,16}$/  && $mykey !~ /^[0-9A-F]{8,8}$/)) {
+       print STDERR "Usage: $PROGRAM_NAME keyid [<keyring> [<keytxt> [<outfile]]]\n";
+       print STDERR "\n";
+       print STDERR "keyid is a long or short keyid (e.g. DE7AAF6E94C09C7F or 94C09C7F\n";
+       exit 1;
+}
+
+-r $keyring or die ("$keyring does not exist\n");
+-r $keytxt or die ("$keytxt does not exist\n");
+
+
+my $sigs;
+
+
+my $tempdir = tempdir( "gpgsigs-XXXXX", DIR => '/tmp/', CLEANUP => 1);
+$ENV{'GNUPGHOME'} = $tempdir;
+print STDERR "Creating a temporary gnupghome and importing keys\n";
+system(qw{gpg --import}, $keyring);
+
+print STDERR "Running --list-sigs, this will take a while\n";
+open SIGS, "gpg --fixed-list-mode --with-colons --list-sigs 2>/dev/null |"
+       or die "can't get gpg listing";
+
+my $key;
+my $uid;
+while (<SIGS>) {
+       if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
+               $key = $1;
+               next;
+       }
+       if ( m/^uid:(?:.*?:){8,8}(.*):/ ) {
+               $uid = $1;
+               $uid = myrecode($uid);
+               next;
+       }
+       if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){3,3}(.*):.*?:/ ) {
+               $sigs->{$key}->{$uid}->{$1.$2} = $3;
+               $sigs->{$key}->{$uid}->{$2} = $3;
+               next;
+       }
+       if ( m/^uat:/ ) {
+               $uid = "Photo ID";
+               next;
+       }
+       next if ( m/^(rev|sub|tru):/ );
+       warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
+}      
+close SIGS;
+
+for my $k ( keys %{$sigs} ) {
+       if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
+               $sigs->{$1} = $sigs->{$k};
+       }
+}
+
+
+open MD, "gpg --print-md md5 $keytxt|" or warn "can't get gpg md5";
+my $MD5 = <MD>;
+close MD;
+open MD, "gpg --print-md sha1 $keytxt|" or warn "can't get gpg sha1";
+my $SHA1 = <MD>;
+close MD;
+
+chomp $MD5;
+chomp $SHA1;
+my $metatxt = quotemeta($keytxt);
+$MD5 =~ s/^$metatxt:\s*//;
+$SHA1 =~ s/^$metatxt:\s*//;
+
+if (defined $MD5) {
+       warn ("md5 of $keytxt does not begin with $EXPECTED_MD5") unless ($MD5 =~ /^$EXPECTED_MD5/);
+};
+
+print STDERR "Annotating $keytxt, writing into $outfile\n";
+open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
+open (WRITE, '>'.$outfile) or die ("Cannot open $outfile for writing\n");
+while (<TXT>) {
+       if (/^MD5 Checksum:  __ __ __ __ __ __ __ __    __ __ __ __ __ __ __ __/ && defined $MD5) {
+               print WRITE "MD5 Checksum:  $MD5     [ ]\n";
+       }
+       elsif (/^SHA1 Checksum: ____ ____ ____ ____ ____    ____ ____ ____ ____ ____/ && defined $SHA1) {
+               print WRITE "SHA1 Checksum: $SHA1   [ ]\n";
+       } else {
+               print WRITE;
+       };
+       if ( m/^([0-9]{3})  \[ \] Fingerprint OK        \[ \] ID OK$/ ) {
+               $_ = <TXT>;
+               if ( m/^pub  ( 768|1024|2048|4096)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} (.*)/ ) {
+                       my $l2 = $_;
+                       my $uid = $3;
+                       my $keyid = $2;
+                       if ( ! defined $sigs->{$keyid}->{$uid} ) {
+                               warn "uid '$uid' not found on key $keyid";
+                       };
+                       print WRITE ( defined $sigs->{$keyid}->{$uid}->{$mykey} ? "(S)" : "( )" );
+                       print WRITE "  $l2";
+                       $_ = <TXT>;
+                       print WRITE $_;
+                       while (<TXT>) {
+                               my $l3 = $_;
+                               if ( m/^uid     (.*)$/ ) {
+                                       print WRITE defined $sigs->{$keyid}->{$1}
+                                               ? ( defined $sigs->{$keyid}->{$1}->{$mykey} ? "(S)" : "( )" )
+                                               : "   ";
+                                       print WRITE "  $l3";
+                               } else {
+                                       print WRITE "$l3";
+                                       last;
+                               }
+                       }
+               } else {
+                       print WRITE "$_";
+               }
+       }
+}
+close TXT