X-Git-Url: https://git.sthu.org/?a=blobdiff_plain;f=gpgsigs%2Fgpgsigs;h=b91f652f5582cc2724953afa5cc0ce4e530b1a95;hb=d43fd478410836437cf2aab71372d5c3f5fc10db;hp=483e4c5b758706e47e4937eb08b20c4c7380531e;hpb=fbc6ef7e900e86687cc5a1526b09700773f24555;p=pgp-tools.git diff --git a/gpgsigs/gpgsigs b/gpgsigs/gpgsigs index 483e4c5..b91f652 100755 --- a/gpgsigs/gpgsigs +++ b/gpgsigs/gpgsigs @@ -17,6 +17,7 @@ # * support for multiple user keys # * better charset conversion # * pod documentation +# see the Debian changelog for further changes. my $VERSION = qq$Rev$; @@ -76,44 +77,19 @@ $charset = "ISO-8859-1" unless $charset =~ /[\.-]/; $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 = ; - 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 @@ -180,7 +156,9 @@ while () { 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}):(?:.*?:){5,5}(.*?):/ ) { @@ -217,9 +195,9 @@ while () { $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"; @@ -231,13 +209,23 @@ for my $k ( keys %{$sigs} ) { # 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 = ; 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 = ; 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); @@ -251,6 +239,9 @@ sub print_tag my ($key, $uid) = @_; if (! defined $sigs->{$key}->{$uid}) { warn "uid '$uid' not found on key $key\n"; + #for (keys %{ $sigs->{$key} }) { + # print STDERR "only have $_\n"; + #}; return '(' . (' ' x @mykeys) . ')'; } my $r = '('; @@ -261,11 +252,15 @@ sub print_tag 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 () { - $_ = myfromrecode($_); + $line++; + $_ = myrecode($_, $fromcharset, $charset); if (/^MD5 Checksum:/ && defined $MD5) { s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/; } @@ -282,7 +277,10 @@ while () { } 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) . " $_"; @@ -372,7 +370,7 @@ http://pgp-tools.alioth.debian.org/ (c) 2004, 2005 Peter Palfrader -(c) 2004, 2005 Christoph Berg +(c) 2004, 2005, 2006 Christoph Berg =head1 LICENSE