]>
git.sthu.org Git - pgp-tools.git/blob - gpgsigs/gpgsigs
5 # See the pod documentation at the end of this file for author,
6 # copyright, and licence information.
9 # libintl-perl (Locale::Recode)
10 # OR libtext-iconv-perl (Text::Iconv),
11 # OR the "recode" binary
16 # * use the user's normal keyring to find signatures
17 # * support for multiple user keys
18 # * better charset conversion
20 # see the Debian changelog for further changes.
22 my $VERSION = qq$Rev$;
36 gpgsigs $VERSION- http://pgp-tools.alioth.debian.org/
37 (c) 2004 Uli Martens <uli\@youam.net>
38 (c) 2004, 2005 Peter Palfrader <peter\@palfrader.org>
39 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb\@df7cb.de>
45 my ($fd, $error) = @_;
50 Usage: $PROGRAM_NAME [-r] [-t <charset>] <keyid> <keytxt> [<outfile>]
52 keyid is a long or short keyid (e.g. DE7AAF6E94C09C7F or 94C09C7F)
53 separate multiple keyids with ','
54 -r call gpg --recv-keys before proceeding
55 -f <charset> convert <keytxt> from charset
56 -t <charset> convert UIDs to charset in output
62 my ($fromcharset, $charset, $recv_keys);
63 Getopt
::Long
::config
('bundling');
65 '-f=s' => \
$fromcharset,
68 help
=> sub { usage
(*STDOUT
, 0); },
69 version
=> sub { version
(*STDOUT
); exit 0;},
70 ) or usage
(*STDERR
, 1);
74 $fromcharset ||= "ISO-8859-1";
75 $charset ||= $ENV{LC_ALL
} || $ENV{LC_CTYPE
} || $ENV{LANG
} || "ISO-8859-1";
76 $charset = "ISO-8859-1" unless $charset =~ /[\.-]/;
82 my ($text, $from, $to) = @_;
84 if (eval "require Locale::Recode") {
85 my $rt = Locale
::Recode
->new (from
=> $from, to
=> $to);
90 } elsif (eval "require Text::Iconv") {
91 my $it = Text
::Iconv
->new($from, $to);
93 my $result = $it->convert($text);
94 warn ("Could not convert '$text'\n") unless defined $result;
95 return (defined $result) ?
$result : $text
97 my $pid = open3
(\
*WTRFH
, \
*RDRFH
, \
*ERRFH
, 'recode', "utf8..$charset");
101 my $result = <RDRFH
>;
105 warn ("'recode' failed, is it installed?\n") unless defined $result;
106 return (defined $result) ?
$result : $text
112 my $mykey = uc(shift @ARGV);
113 my $keytxt = (shift @ARGV) || usage
(*STDERR
, 1);
114 my $outfile = (shift @ARGV) || '-';
116 my @mykeys = split /,/, $mykey;
117 map { s/^0x//i; } @mykeys;
118 my %myuids = map { $_ => [] } @mykeys;
120 if (!@mykeys || scalar @ARGV) {
123 foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
124 print STDERR
"Invalid keyid $falsekey given\n";
128 -r
$keytxt or die ("$keytxt does not exist\n");
131 # get list of keys in file
133 open (TXT
, $keytxt) or die ("Cannot open $keytxt\n");
135 if ( m/^pub +(?:\d+)[DR]\/([0-9A
-F
]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
142 # get all known signatures
144 print STDERR
"Requesting keys from keyserver\n";
145 system "gpg --recv-keys @keys";
148 print STDERR
"Running --list-sigs, this will take a while ";
149 open SIGS
, "gpg --fixed-list-mode --with-colons --list-sigs @mykeys @keys 2>/dev/null |"
150 or die "can't get gpg listing";
152 my ($key, $uid, $sigs, $uidstatus);
154 if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
159 if ( m/^uid:(.):(?:.*?:){7,7}(.*):/s ) {
162 $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
163 $uid = myrecode
($uid, "UTF-8", $charset);
165 my ($shortkey) = substr $key, -8;
166 # Remember own, non-revoked uids
167 if (exists $myuids{$shortkey} and $uidstatus ne "r") {
168 push @
{$myuids{$shortkey}}, $uid
173 if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
175 if ($class eq '10x') {
177 } elsif ($class eq '11x') {
179 } elsif ($class eq '12x') {
181 } elsif ($class eq '13x') {
186 # Handle the case where one UID was signed multiple times
187 # with different signature classes.
188 my $before = $sigs->{$key}->{$uid}->{$1.$2};
189 if (defined $before) {
190 if ($before eq 'S' || $before eq 's') {
191 $sigs->{$key}->{$uid}->{$1.$2} = $class;
192 } elsif ($class eq 'S' || $class eq 's') {
193 # intentionall left blank
194 } elsif ($before < $class) {
195 $sigs->{$key}->{$uid}->{$1.$2} = $class;
198 $sigs->{$key}->{$uid}->{$1.$2} .= $class;
200 $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
207 next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
208 warn "unknown value: '$_', key: ".(defined $key ?
$key :'none')."\n";
213 for my $k ( keys %{$sigs} ) {
214 if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
215 $sigs->{$1} = $sigs->{$k};
221 open MD
, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
224 open MD
, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
227 open MD
, "gpg --with-colons --print-md sha256 $keytxt|" or warn "can't get gpg sha256\n";
231 my @MD5 = split /:/, $MD5;
232 my @SHA1 = split /:/, $SHA1;
233 my @SHA256 = split /:/, $SHA256;
236 $SHA256 = $SHA256[2];
238 $MD5 =~ s/(.{16})/$1 /;
239 $SHA1 =~ s/(.{20})/$1 /;
240 $SHA256 =~ s/(.{32})/$1 /;
241 $MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
242 $SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
243 $SHA256 =~ s/([0-9A-Z]{4})/$1 /ig;
248 my $metatxt = quotemeta($keytxt);
249 $MD5 =~ s/^$metatxt:\s*//;
250 $SHA1 =~ s/^$metatxt:\s*//;
251 $SHA256 =~ s/^$metatxt:\s*//;
257 my ($key, $uid) = @_;
258 if (! defined $sigs->{$key}->{$uid}) {
259 warn "uid '$uid' not found on key $key\n";
260 #for (keys %{ $sigs->{$key} }) {
261 # print STDERR "only have $_\n";
263 return '(' . (' ' x
@mykeys) . ')';
266 foreach my $mykey (@mykeys) {
267 $r .= defined $sigs->{$key}->{$uid}->{$mykey} ?
$sigs->{$key}->{$uid}->{$mykey} : ' ';
276 print STDERR
"Annotating $keytxt, writing into $outfile\n";
277 open (TXT
, $keytxt) or die ("Cannot open $keytxt\n");
278 open (WRITE
, '>'.$outfile) or die ("Cannot open $outfile for writing\n");
281 $_ = myrecode
($_, $fromcharset, $charset);
282 if (/^MD5 Checksum:/ && defined $MD5) {
283 s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
285 if (/^SHA1 Checksum:/ && defined $SHA1) {
286 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
288 if (/^SHA256 Checksum:/ && defined $SHA256) {
289 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA256/;
291 if ( m/^pub +(?:\d+)[DR]\/([0-9A
-F
]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
294 #if ($uid) { # in gpg 1.2, the first uid is here
295 # print WRITE print_tag($key, $uid) . " $_";
300 foreach my $mykey (@mykeys) {
301 foreach my $myuid (@
{$myuids{$mykey}}) {
302 $inc .= defined $sigs->{$mykey}->{$myuid}->{$key} ?
$sigs->{$mykey}->{$myuid}->{$key} : ' ';
305 print WRITE
"[$inc] incoming signatures\n" if $inc =~ /\S/;
309 if ( m/^uid +(.*)$/ ) {
311 unless (defined $key) {
312 warn "key is undefined - input text is possibly malformed near line $line\n";
315 die "uid is undefined, key $key" unless defined $uid;
316 die "bad tag from $key | $uid" unless defined (print_tag
($key, $uid));
317 print WRITE print_tag
($key, $uid) . " $_";
323 print WRITE
"Legend:\n";
325 foreach my $i (0 .. @mykeys - 1) {
326 print WRITE
'(' . ' 'x
$i . 'S' . ' 'x
(@mykeys-$i-1) . ") signed with $mykeys[$i] $myuids{$mykeys[$i]}->[0]\n";
327 $num_myuids += @
{$myuids{$mykeys[$i]}};
330 foreach my $mykey (@mykeys) {
331 foreach my $myuid (@
{$myuids{$mykey}}) {
332 my $inc = defined $sigs->{$mykey}->{$myuid}->{$key} ?
$sigs->{$mykey}->{$myuid}->{$key} : ' ';
333 print WRITE
"[" . ' 'x
$i . 'S' . ' 'x
($num_myuids-$i-1) . "] has signed $mykey $myuid\n";
343 B<gpgsigs> - annotate list of GnuPG keys with already done signatures
347 B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
351 B<gpgsigs> was written to assist the user in signing keys during a keysigning
352 party. It takes as input a file containing keys in C<gpg --list-keys> format
353 and prepends every line with a tag indicating if the user has already signed
354 that uid. When the file contains C<MD5 Checksum:> or C<SHA1 Checksum:> lines
355 and placeholders (C<__ __>), the checksum is inserted.
363 Call I<gpg --recv-keys> before creating the output.
367 Convert F<keytxt> from I<charset>. The default is ISO-8859-1.
371 Convert UIDs to I<charset>. The default is derived from LC_ALL, LC_CTYPE, and
372 LANG, and if all these are unset, the default is ISO-8859-1.
376 Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
381 Read input from F<keytxt>.
385 Write output to F<outfile>. Default is stdout.
391 The following key signing parties are using B<gpgsigs>:
393 http://www.palfrader.org/ksp-lt2k4.html
395 http://www.palfrader.org/ksp-lt2k5.html
399 B<GnuPG> is known to change its output format quite often. This version has
400 been tested with gpg 1.2.5 and gpg 1.4.1. YMMV.
406 http://pgp-tools.alioth.debian.org/
408 =head1 AUTHORS AND COPYRIGHT
410 (c) 2004 Uli Martens <uli@youam.net>
412 (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
414 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb@df7cb.de>
420 Redistribution and use in source and binary forms, with or without
421 modification, are permitted provided that the following conditions
424 1. Redistributions of source code must retain the above copyright
425 notice, this list of conditions and the following disclaimer.
427 2. Redistributions in binary form must reproduce the above copyright
428 notice, this list of conditions and the following disclaimer in the
429 documentation and/or other materials provided with the distribution.
431 3. The name of the author may not be used to endorse or promote products
432 derived from this software without specific prior written permission.
434 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
435 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
436 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
437 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
438 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
439 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
440 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
441 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
442 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
443 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.