[Pgp-tools-commit] r39 - in trunk: . gpgsigs
Christoph Berg
myon-guest at costa.debian.org
Sat May 21 20:54:24 UTC 2005
Author: myon-guest
Date: 2005-05-21 20:54:24 +0000 (Sat, 21 May 2005)
New Revision: 39
Added:
trunk/gpgsigs/
trunk/gpgsigs/gpgsigs
Log:
2004 version of youam's gpgsigs tool
Added: trunk/gpgsigs/gpgsigs
===================================================================
--- trunk/gpgsigs/gpgsigs 2005-04-04 13:24:00 UTC (rev 38)
+++ trunk/gpgsigs/gpgsigs 2005-05-21 20:54:24 UTC (rev 39)
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+
+# Copyright (c) 2004 Uli Martens <uli at youam.net>
+# Copyright (c) 2004 Peter Palfrader <peter at palfrader.org>
+# Copyright (c) 2004 Christoph Berg <cb at 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
More information about the Pgp-tools-commit
mailing list