#!/usr/bin/perl
+# $Id$
+
# See the pod documentation at the end of this file for author,
# copyright, and licence information.
#
# * support for multiple user keys
# * better charset conversion
# * pod documentation
+# see the Debian changelog for further changes.
-my $VERSION = "0.2";
+my $VERSION = qq$Rev$;
use strict;
use warnings;
use Getopt::Long;
-sub version
+sub version($)
{
- print STDERR <<EOF;
-gpgsigs $VERSION - http://pgp-tools.alioth.debian.org/
+ my ($fd) = @_;
+
+ print $fd <<EOF;
+gpgsigs $VERSION- http://pgp-tools.alioth.debian.org/
(c) 2004 Uli Martens <uli\@youam.net>
- (c) 2004 Peter Palfrader <peter\@palfrader.org>
+ (c) 2004
, 2005 Peter Palfrader <peter\@palfrader.org>
(c) 2004, 2005 Christoph Berg <cb\@df7cb.de>
EOF
}
-sub usage
+sub usage($$)
{
- version();
- print STDERR <<EOF;
+ my ($fd, $error) = @_;
+
+ version($fd);
+ print $fd <<EOF;
Usage: $PROGRAM_NAME [-r] [-t <charset>] <keyid> <keytxt> [<outfile>]
-f <charset> convert <keytxt> from charset
-t <charset> convert UIDs to charset in output
EOF
- exit shift;
+ exit $error;
}
my ($fromcharset, $charset, $recv_keys);
+Getopt::Long::config('bundling');
GetOptions(
- f => \$fromcharset,
- t => \$charset,
+ '-f=s' => \$fromcharset,
+ '-t=s' => \$charset,
r => \$recv_keys,
- help => sub { usage(0); },
- version => sub { version(); exit 0;},
-) or usage(1);
+ help => sub { usage(*STDOUT, 0); },
+ version => sub { version(*STDOUT); exit 0;},
+) or usage(*STDERR, 1);
# charset conversion
$charset =~ s/.*\.//;
$charset =~ s/@.*//;
-my ($rf, $rt, $if, $it);
-if (eval "require Locale::Recode") {
- $rf = Locale::Recode->new (from => $fromcharset, to => $charset) if $fromcharset;
- $rt = Locale::Recode->new (from => 'UTF-8', to => $charset);
-} elsif (eval "require Text::Iconv") {
- $if = Text::Iconv->new($fromcharset, $charset) if $fromcharset;
- $it = Text::Iconv->new("UTF-8", $charset);
-}
-sub myfromrecode($) {
- my ($text) = @_;
- if (defined $rf) {
- my $orig = $text;
- $rf->recode($text);
- return $text;
- } elsif (defined $if) {
- return $if->convert($text);
- } else {
- my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "$fromcharset..$charset");
- 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;
- return $result;
- }
-}
+sub myrecode($$$) {
+ my ($text, $from, $to) = @_;
+
+ if (eval "require Locale::Recode") {
+ my $rt = Locale::Recode->new (from => $from, to => $to);
-sub myrecode($) {
- my ($text) = @_;
- if (defined $rt) {
my $orig = $text;
$rt->recode($text);
return $text;
- } elsif (defined $it) {
+ } elsif (eval "require Text::Iconv") {
+ my $it = Text::Iconv->new($from, $to);
+
my $result = $it->convert($text);
warn ("Could not convert '$text'\n") unless defined $result;
return (defined $result) ? $result : $text
# parse options
my $mykey = uc(shift @ARGV);
-my $keytxt = (shift @ARGV) || usage(1);
+my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
my $outfile = (shift @ARGV) || '-';
my @mykeys = split /,/, $mykey;
map { s/^0x//i; } @mykeys;
if (!@mykeys || scalar @ARGV) {
- usage(1);
+ usage(*STDERR, 1);
}
-if (!grep { /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
- print STDERR "Invalid keyid given\n";
- usage(1);
+foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
+ print STDERR "Invalid keyid $falsekey given\n";
+ usage(*STDERR, 1);
}
-r $keytxt or die ("$keytxt does not exist\n");
next;
}
if ( m/^uid:(?:.*?:){8,8}(.*):/s ) {
- $uid = myrecode($1);
+ $uid = $1;
+ $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
+ $uid = myrecode($uid, "UTF-8", $charset);
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;
+ if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
+ my $class = $3;
+ if ($class eq '10x') {
+ $class = 'S';
+ } elsif ($class eq '11x') {
+ $class = '1';
+ } elsif ($class eq '12x') {
+ $class = '2';
+ } elsif ($class eq '13x') {
+ $class = '3';
+ } else {
+ $class = 's';
+ };
+ # Handle the case where one UID was signed multiple times
+ # with different signature classes.
+ my $before = $sigs->{$key}->{$uid}->{$1.$2};
+ if (defined $before) {
+ if ($before eq 'S' || $before eq 's') {
+ $sigs->{$key}->{$uid}->{$1.$2} = $class;
+ } elsif ($class eq 'S' || $class eq 's') {
+ # intentionall left blank
+ } elsif ($before < $class) {
+ $sigs->{$key}->{$uid}->{$1.$2} = $class;
+ };
+ } else {
+ $sigs->{$key}->{$uid}->{$1.$2} .= $class;
+ };
+ $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
next;
}
if ( m/^uat:/ ) {
$uid = "Photo ID";
next;
}
- next if ( m/^(rev|sub|tru):/ );
+ next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
-}
+}
close SIGS;
print STDERR "\n";
# read checksums
-open MD, "gpg --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
+open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
my $MD5 = <MD>;
close MD;
-open MD, "gpg --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
+open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
my $SHA1 = <MD>;
close MD;
+my @MD5 = split /:/, $MD5;
+my @SHA1 = split /:/, $SHA1;
+$MD5 = $MD5[2];
+$SHA1 = $SHA1[2];
+
+$MD5 =~ s/(.{16})/$1 /;
+$SHA1 =~ s/(.{20})/$1 /;
+$MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
+$SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
+
chomp $MD5;
chomp $SHA1;
my $metatxt = quotemeta($keytxt);
my ($key, $uid) = @_;
if (! defined $sigs->{$key}->{$uid}) {
warn "uid '$uid' not found on key $key\n";
- return '(_)';
+ #for (keys %{ $sigs->{$key} }) {
+ # print STDERR "only have $_\n";
+ #};
+ return '(' . (' ' x @mykeys) . ')';
}
my $r = '(';
foreach my $mykey (@mykeys) {
- $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? "S" : " ";
+ $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
}
$r .= ')';
return $r;
}
+$key = undef;
+$uid = undef;
+my $line = 0;
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>) {
- $_ = myfromrecode($_);
+ $line++;
+ $_ = myrecode($_, $fromcharset, $charset);
if (/^MD5 Checksum:/ && defined $MD5) {
- s/_[_ ]+_/$MD5/;
+ s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
}
if (/^SHA1 Checksum:/ && defined $SHA1) {
- s/_[_ ]+_/$SHA1/;
+ s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
}
if ( m/^pub +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
$key = $1;
}
if ( m/^uid +(.*)$/ ) {
$uid = $1;
- die "key is undefined" unless defined $key;
+ unless (defined $key) {
+ warn "key is undefined - input text is possibly malformed near line $line\n";
+ next;
+ };
die "uid is undefined, key $key" unless defined $uid;
die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
print WRITE print_tag($key, $uid) . " $_";
=head1 SYNOPSIS
-B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] I<keyid> F<keytxt> [F<outfile>]
+B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
=head1 DESCRIPTION
=item I<keyid>
Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
-by I<,>.
+by a comma (B<,>).
=item F<keytxt>
(c) 2004 Uli Martens <uli@youam.net>
-(c) 2004 Peter Palfrader <peter@palfrader.org>
+(c) 2004
, 2005 Peter Palfrader <peter@palfrader.org>
-(c) 2004, 2005 Christoph Berg <cb@df7cb.de>
+(c) 2004, 2005, 2006 Christoph Berg <cb@df7cb.de>
=head1 LICENSE
projects / pgp-tools.git / blobdiff