gpgsigs/gpgsigs

   1 #!/usr/bin/perl
   2
   3 # $Id$
   4
   5 # See the pod documentation at the end of this file for author,
   6 # copyright, and licence information.
   7 #
   8 # Depends:
   9 #          libintl-perl (Locale::Recode)
  10 #       OR libtext-iconv-perl (Text::Iconv),
  11 #       OR the "recode" binary
  12 #
  13 # Changelog:
  14 # 0.1
  15 # 0.2 2005-05-14 cb:
  16 #   * use the user's normal keyring to find signatures
  17 #   * support for multiple user keys
  18 #   * better charset conversion
  19 #   * pod documentation
  20 # see the Debian changelog for further changes.
  21
  22 my $VERSION = qq$Rev$;
  23
  24 use strict;
  25 use warnings;
  26 use English;
  27 use IPC::Open3;
  28 use Getopt::Long;
  29
  30
  31 sub version($)
  32 {
  33         my ($fd) = @_;
  34
  35         print $fd <<EOF;
  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>
  40 EOF
  41 }
  42
  43 sub usage($$)
  44 {
  45         my ($fd, $error) = @_;
  46
  47         version($fd);
  48         print $fd <<EOF;
  49
  50 Usage: $PROGRAM_NAME [-r] [-t <charset>] <keyid> <keytxt> [<outfile>]
  51
  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
  57 EOF
  58         exit $error;
  59 }
  60
  61
  62 my ($fromcharset, $charset, $recv_keys);
  63 Getopt::Long::config('bundling');
  64 GetOptions(
  65         '-f=s' => \$fromcharset,
  66         '-t=s' => \$charset,
  67         r => \$recv_keys,
  68         help => sub { usage(*STDOUT, 0); },
  69         version => sub { version(*STDOUT); exit 0;},
  70 ) or usage(*STDERR, 1);
  71
  72
  73 # charset conversion
  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 =~ /[\.-]/;
  77 $charset =~ s/.*\.//;
  78 $charset =~ s/@.*//;
  79
  80
  81 sub myrecode($$$) {
  82         my ($text, $from, $to) = @_;
  83
  84         if (eval "require Locale::Recode") {
  85                 my $rt = Locale::Recode->new (from => $from, to => $to);
  86
  87                 my $orig = $text;
  88                 $rt->recode($text);
  89                 return $text;
  90         } elsif (eval "require Text::Iconv") {
  91                 my $it = Text::Iconv->new($from, $to);
  92
  93                 my $result = $it->convert($text);
  94                 warn ("Could not convert '$text'\n") unless defined $result;
  95                 return (defined $result) ? $result : $text
  96         } else {
  97                 my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "utf8..$charset");
  98                 print WTRFH $text;
  99                 close WTRFH;
 100                 local $/ = undef;
 101                 my $result = <RDRFH>;
 102                 close RDRFH;
 103                 close ERRFH;
 104                 waitpid $pid, 0;
 105                 warn ("'recode' failed, is it installed?\n") unless defined $result;
 106                 return (defined $result) ? $result : $text
 107         }
 108 }
 109
 110
 111 # parse options
 112 my $mykey = uc(shift @ARGV);
 113 my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
 114 my $outfile = (shift @ARGV) || '-';
 115
 116 my @mykeys = split /,/, $mykey;
 117 map { s/^0x//i; } @mykeys;
 118 my %myuids = map { $_ => [] } @mykeys;
 119
 120 if (!@mykeys || scalar @ARGV) {
 121         usage(*STDERR, 1);
 122 }
 123 foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
 124         print STDERR "Invalid keyid $falsekey given\n";
 125         usage(*STDERR, 1);
 126 }
 127
 128 -r $keytxt or die ("$keytxt does not exist\n");
 129
 130
 131 # get list of keys in file
 132 my @keys;
 133 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
 134 while (<TXT>) {
 135         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 136                 push @keys, $1;
 137         }
 138 }
 139 close TXT;
 140
 141
 142 # get all known signatures
 143 if ($recv_keys) {
 144         print STDERR "Requesting keys from keyserver\n";
 145         system "gpg --recv-keys @keys";
 146 }
 147
 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";
 151
 152 my ($key, $uid, $sigs, $uidstatus);
 153 while (<SIGS>) {
 154         if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
 155                 $key = $1;
 156                 print STDERR ".";
 157                 next;
 158         }
 159         if ( m/^uid:(.):(?:.*?:){7,7}(.*):/s ) {
 160                 $uidstatus = $1;
 161                 $uid = $2;
 162                 $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
 163                 $uid = myrecode($uid, "UTF-8", $charset);
 164
 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
 169                 }
 170
 171                 next;
 172         }
 173         if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
 174                 my $class = $3;
 175                 if ($class eq '10x') {
 176                         $class = 'S';
 177                 } elsif ($class eq '11x') {
 178                         $class = '1';
 179                 } elsif ($class eq '12x') {
 180                         $class = '2';
 181                 } elsif ($class eq '13x') {
 182                         $class = '3';
 183                 } else {
 184                         $class = 's';
 185                 };
 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;
 196                         };
 197                 } else {
 198                         $sigs->{$key}->{$uid}->{$1.$2} .= $class;
 199                 };
 200                 $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
 201                 next;
 202         }
 203         if ( m/^uat:/ ) {
 204                 $uid = "Photo ID";
 205                 next;
 206         }
 207         next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
 208         warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
 209 }
 210 close SIGS;
 211 print STDERR "\n";
 212
 213 for my $k ( keys %{$sigs} ) {
 214         if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
 215                 $sigs->{$1} = $sigs->{$k};
 216         }
 217 }
 218
 219
 220 # read checksums
 221 open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
 222 my $MD5 = <MD>;
 223 close MD;
 224 open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
 225 my $SHA1 = <MD>;
 226 close MD;
 227 open MD, "gpg --with-colons --print-md sha256 $keytxt|" or warn "can't get gpg sha256\n";
 228 my $SHA256 = <MD>;
 229 close MD;
 230
 231 my @MD5 = split /:/, $MD5;
 232 my @SHA1 = split /:/, $SHA1;
 233 my @SHA256 = split /:/, $SHA256;
 234 $MD5 = $MD5[2];
 235 $SHA1 = $SHA1[2];
 236 $SHA256 = $SHA256[2];
 237
 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;
 244
 245 chomp $MD5;
 246 chomp $SHA1;
 247 chomp $SHA256;
 248 my $metatxt = quotemeta($keytxt);
 249 $MD5 =~ s/^$metatxt:\s*//;
 250 $SHA1 =~ s/^$metatxt:\s*//;
 251 $SHA256 =~ s/^$metatxt:\s*//;
 252
 253
 254 # write out result
 255 sub print_tag
 256 {
 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";
 262                 #};
 263                 return '(' . (' ' x @mykeys) . ')';
 264         }
 265         my $r = '(';
 266         foreach my $mykey (@mykeys) {
 267                 $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
 268         }
 269         $r .= ')';
 270         return $r;
 271 }
 272
 273 $key = undef;
 274 $uid = undef;
 275 my $line = 0;
 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");
 279 while (<TXT>) {
 280         $line++;
 281         $_ = myrecode($_, $fromcharset, $charset);
 282         if (/^MD5 Checksum:/ && defined $MD5) {
 283                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
 284         }
 285         if (/^SHA1 Checksum:/ && defined $SHA1) {
 286                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
 287         }
 288         if (/^SHA256 Checksum:/ && defined $SHA256) {
 289                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA256/;
 290         }
 291         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 292                 $key = $1;
 293                 $uid = $2;
 294                 #if ($uid) { # in gpg 1.2, the first uid is here
 295                 #       print WRITE print_tag($key, $uid) . " $_";
 296                 #       next;
 297                 #}
 298                 print WRITE;
 299                 my $inc = "";
 300                 foreach my $mykey (@mykeys) {
 301                         foreach my $myuid (@{$myuids{$mykey}}) {
 302                                 $inc .= defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
 303                         }
 304                 }
 305                 print WRITE "[$inc] incoming signatures\n" if $inc =~ /\S/;
 306                 next;
 307
 308         }
 309         if ( m/^uid +(.*)$/ ) {
 310                 $uid = $1;
 311                 unless (defined $key) {
 312                         warn "key is undefined - input text is possibly malformed near line $line\n";
 313                         next;
 314                 };
 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) . " $_";
 318                 next;
 319         }
 320         print WRITE;
 321 }
 322
 323 print WRITE "Legend:\n";
 324 my $num_myuids = 0;
 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]}};
 328 }
 329 my $i = 0;
 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";
 334                 $i++;
 335         }
 336 }
 337 close TXT;
 338
 339 __END__
 340
 341 =head1 NAME
 342
 343 B<gpgsigs> - annotate list of GnuPG keys with already done signatures
 344
 345 =head1 SYNOPSIS
 346
 347 B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
 348
 349 =head1 DESCRIPTION
 350
 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.
 356
 357 =head1 OPTIONS
 358
 359 =over
 360
 361 =item -r
 362
 363 Call I<gpg --recv-keys> before creating the output.
 364
 365 =item -f I<charset>
 366
 367 Convert F<keytxt> from I<charset>. The default is ISO-8859-1.
 368
 369 =item -t I<charset>
 370
 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.
 373
 374 =item I<keyid>
 375
 376 Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
 377 by a comma (B<,>).
 378
 379 =item F<keytxt>
 380
 381 Read input from F<keytxt>.
 382
 383 =item F<outfile>
 384
 385 Write output to F<outfile>. Default is stdout.
 386
 387 =back
 388
 389 =head1 EXAMPLES
 390
 391 The following key signing parties are using B<gpgsigs>:
 392
 393 http://www.palfrader.org/ksp-lt2k4.html
 394
 395 http://www.palfrader.org/ksp-lt2k5.html
 396
 397 =head1 BUGS
 398
 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.
 401
 402 =head1 SEE ALSO
 403
 404 gpg(1), caff(1).
 405
 406 http://pgp-tools.alioth.debian.org/
 407
 408 =head1 AUTHORS AND COPYRIGHT
 409
 410 (c) 2004 Uli Martens <uli@youam.net>
 411
 412 (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
 413
 414 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb@df7cb.de>
 415
 416 =head1 LICENSE
 417
 418 All rights reserved.
 419
 420 Redistribution and use in source and binary forms, with or without
 421 modification, are permitted provided that the following conditions
 422 are met:
 423
 424 1. Redistributions of source code must retain the above copyright
 425 notice, this list of conditions and the following disclaimer.
 426
 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.
 430
 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.
 433
 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.