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 --refresh     regenerate UID lists on keys
  58 --latex       generate LaTeX output including photo IDs
  59 EOF
  60         exit $error;
  61 }
  62
  63
  64 my ($fromcharset, $charset, $recv_keys, $refresh, $latex);
  65 Getopt::Long::config('bundling');
  66 GetOptions(
  67         '-f=s' => \$fromcharset,
  68         '-t=s' => \$charset,
  69         r => \$recv_keys,
  70         refresh => \$refresh,
  71         latex => \$latex,
  72         help => sub { usage(*STDOUT, 0); },
  73         version => sub { version(*STDOUT); exit 0;},
  74 ) or usage(*STDERR, 1);
  75
  76
  77 # charset conversion
  78 $fromcharset ||= "ISO-8859-1";
  79 $charset ||= $ENV{LC_ALL} || $ENV{LC_CTYPE} || $ENV{LANG} || "ISO-8859-1";
  80 $charset = "ISO-8859-1" unless $charset =~ /[\.-]/;
  81 $charset =~ s/.*\.//;
  82 $charset =~ s/@.*//;
  83
  84
  85 sub myrecode($$$) {
  86         my ($text, $from, $to) = @_;
  87
  88         if (eval "require Locale::Recode") {
  89                 my $rt = Locale::Recode->new (from => $from, to => $to);
  90
  91                 my $orig = $text;
  92                 $rt->recode($text);
  93                 return $text;
  94         } elsif (eval "require Text::Iconv") {
  95                 my $it = Text::Iconv->new($from, $to);
  96
  97                 my $result = $it->convert($text);
  98                 warn ("Could not convert '$text'\n") unless defined $result;
  99                 return (defined $result) ? $result : $text
 100         } else {
 101                 my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "utf8..$charset");
 102                 print WTRFH $text;
 103                 close WTRFH;
 104                 local $/ = undef;
 105                 my $result = <RDRFH>;
 106                 close RDRFH;
 107                 close ERRFH;
 108                 waitpid $pid, 0;
 109                 warn ("'recode' failed, is it installed?\n") unless defined $result;
 110                 return (defined $result) ? $result : $text
 111         }
 112 }
 113
 114
 115 # parse options
 116 my @mykeys = split /,/, uc(shift @ARGV);
 117 my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
 118 my $outfile = (shift @ARGV) || '-';
 119
 120 map { s/^0x//i; } @mykeys;
 121 my %uids = map { $_ => [] } @mykeys;
 122
 123 if (!@mykeys || scalar @ARGV) {
 124         usage(*STDERR, 1);
 125 }
 126 foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
 127         print STDERR "Invalid keyid $falsekey given\n";
 128         usage(*STDERR, 1);
 129 }
 130
 131 -r $keytxt or die ("$keytxt does not exist\n");
 132
 133
 134 # get list of keys in file
 135 my @keys;
 136 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
 137 while (<TXT>) {
 138         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 139                 push @keys, $1;
 140         }
 141 }
 142 close TXT;
 143
 144
 145 # get all known signatures
 146 if ($recv_keys) {
 147         print STDERR "Requesting keys from keyserver\n";
 148         system "gpg --recv-keys @keys";
 149 }
 150
 151 print STDERR "Running --list-sigs, this will take a while ";
 152 open SIGS, "gpg --fixed-list-mode --with-colons --list-sigs @mykeys @keys 2>/dev/null |"
 153         or die "can't get gpg listing";
 154
 155 my ($key, $uid, $sigs);
 156 while (<SIGS>) {
 157         if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
 158                 $key = $1;
 159                 print STDERR ".";
 160                 next;
 161         }
 162         if ( m/^uid:(.):(?:.*?:){7,7}(.*):/s ) {
 163                 my $uidstatus = $1;
 164                 $uid = $2;
 165                 $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
 166                 $uid = myrecode($uid, "UTF-8", $charset);
 167
 168                 my ($shortkey) = substr $key, -8;
 169                 # Remember non-revoked uids
 170                 next if $uidstatus eq "r";
 171                 push @{$uids{$shortkey}}, $uid;
 172                 next;
 173         }
 174         if ( m/^uat:(.)::::[^:]+::([0-9A-F]+)::\d+ (\d+)/ ) { # uat:-::::2006-08-03::27BAEAF742BD253C2F3F03B043DC1536880193C4::1 7993:
 175                 my $uidstatus = $1;
 176                 # $2 is hash of attribute data
 177                 my $size = $3 - 19; # FIXME: find a nicer way to find out picture size
 178                 $uid = "[jpeg image of size $size]";
 179                 next if $uidstatus eq "r";
 180                 if ($latex) {
 181                         system "gpg --photo-viewer 'convert - %k.eps' --list-options show-photos --list-key $key > /dev/null";
 182                 }
 183                 my ($shortkey) = substr $key, -8;
 184                 push @{$uids{$shortkey}}, $uid;
 185                 next;
 186         }
 187         if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
 188                 my $class = $3;
 189                 if ($class eq '10x') {
 190                         $class = 'S';
 191                 } elsif ($class eq '11x') {
 192                         $class = '1';
 193                 } elsif ($class eq '12x') {
 194                         $class = '2';
 195                 } elsif ($class eq '13x') {
 196                         $class = '3';
 197                 } else {
 198                         $class = 's';
 199                 };
 200                 # Handle the case where one UID was signed multiple times
 201                 # with different signature classes.
 202                 my $before = $sigs->{$key}->{$uid}->{$1.$2};
 203                 if (defined $before) {
 204                         if ($before eq 'S' || $before eq 's') {
 205                                 $sigs->{$key}->{$uid}->{$1.$2} = $class;
 206                         } elsif ($class eq 'S' || $class eq 's') {
 207                                 # intentionally left blank
 208                         } elsif ($before < $class) {
 209                                 $sigs->{$key}->{$uid}->{$1.$2} = $class;
 210                         };
 211                 } else {
 212                         $sigs->{$key}->{$uid}->{$1.$2} .= $class;
 213                 };
 214                 $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
 215                 next;
 216         }
 217         next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
 218         warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
 219 }
 220 close SIGS;
 221 print STDERR "\n";
 222
 223 for my $k ( keys %{$sigs} ) {
 224         if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
 225                 $sigs->{$1} = $sigs->{$k};
 226         }
 227 }
 228
 229
 230 # read checksums
 231 open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
 232 my $MD5 = <MD>;
 233 close MD;
 234 open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
 235 my $SHA1 = <MD>;
 236 close MD;
 237 open MD, "gpg --with-colons --print-md sha256 $keytxt|" or warn "can't get gpg sha256\n";
 238 my $SHA256 = <MD>;
 239 close MD;
 240
 241 my @MD5 = split /:/, $MD5;
 242 my @SHA1 = split /:/, $SHA1;
 243 my @SHA256 = split /:/, $SHA256;
 244 $MD5 = $MD5[2];
 245 $SHA1 = $SHA1[2];
 246 $SHA256 = $SHA256[2];
 247
 248 $MD5 =~ s/(.{16})/$1 /;
 249 $SHA1 =~ s/(.{20})/$1 /;
 250 $SHA256 =~ s/(.{32})/$1 /;
 251 $MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
 252 $SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
 253 $SHA256 =~ s/([0-9A-Z]{4})/$1 /ig;
 254
 255 chomp $MD5;
 256 chomp $SHA1;
 257 chomp $SHA256;
 258 my $metatxt = quotemeta($keytxt);
 259 $MD5 =~ s/^$metatxt:\s*//;
 260 $SHA1 =~ s/^$metatxt:\s*//;
 261 $SHA256 =~ s/^$metatxt:\s*//;
 262
 263
 264 # write out result
 265 sub print_tag
 266 {
 267         my ($key, $uid) = @_;
 268         if (! defined $sigs->{$key}->{$uid}) {
 269                 warn "uid '$uid' not found on key $key\n";
 270                 #for (keys %{ $sigs->{$key} }) {
 271                 #       print STDERR "only have $_\n";
 272                 #};
 273                 return '(' . (' ' x @mykeys) . ')';
 274         }
 275         my $r = '(';
 276         foreach my $mykey (@mykeys) {
 277                 $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
 278         }
 279         $r .= ')';
 280         return $r;
 281 }
 282
 283 $key = undef;
 284 $uid = undef;
 285 my $line = 0;
 286 print STDERR "Annotating $keytxt, writing into $outfile\n";
 287 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
 288 open (WRITE, '>'.$outfile) or die ("Cannot open $outfile for writing\n");
 289
 290 if ($latex) {
 291         print WRITE <<'EOF';
 292 \documentclass{article}
 293 \usepackage[margin=2cm]{geometry}
 294 \usepackage{alltt}
 295 \usepackage{graphicx}
 296 \begin{document}
 297 \begin{alltt}
 298 EOF
 299 }
 300
 301 while (<TXT>) {
 302         $line++;
 303         $_ = myrecode($_, $fromcharset, $charset);
 304         if (/^MD5 Checksum:/ && defined $MD5) {
 305                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
 306         }
 307         if (/^SHA1 Checksum:/ && defined $SHA1) {
 308                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
 309         }
 310         if (/^SHA256 Checksum:/ && defined $SHA256) {
 311                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA256/;
 312         }
 313         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 314                 $key = $1;
 315                 $uid = $2;
 316                 #if ($uid) { # in gpg 1.2, the first uid is here
 317                 #       print WRITE print_tag($key, $uid) . " $_";
 318                 #       next;
 319                 #}
 320                 print WRITE;
 321                 next;
 322         }
 323
 324         if ( m/^ *Key fingerprint/ ) {
 325                 print WRITE;
 326                 my $inc = "";
 327                 foreach my $mykey (@mykeys) {
 328                         foreach my $myuid (@{$uids{$mykey}}) {
 329                                 $inc .= defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
 330                         }
 331                 }
 332                 print WRITE "[$inc] incoming signatures\n" if $inc =~ /\S/;
 333                 if ($refresh or $latex) {
 334                         foreach $uid (@{$uids{$key}}) {
 335                                 print WRITE print_tag($key, $uid) . " $uid\n";
 336                                 if ($latex and ($uid =~ /^\[jpeg image/)) {
 337                                         print WRITE "\\begin{flushright}\n";
 338                                         print WRITE "\\includegraphics[height=3cm]{$key.eps}\n";
 339                                         print WRITE "\\end{flushright}\n";
 340                                 }
 341                         }
 342                 }
 343                 next;
 344
 345         }
 346         if ( m/^uid +(.*)$/ ) {
 347                 $uid = $1;
 348                 next if $refresh or $latex;
 349                 unless (defined $key) {
 350                         warn "key is undefined - input text is possibly malformed near line $line\n";
 351                         next;
 352                 };
 353                 die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
 354                 print WRITE print_tag($key, $uid) . " $_";
 355                 next;
 356         }
 357         print WRITE;
 358 }
 359
 360 print WRITE "Legend:\n";
 361 my $num_myuids = 0;
 362 foreach my $i (0 .. @mykeys - 1) {
 363         print WRITE '(' . ' 'x$i . 'S' . ' 'x(@mykeys-$i-1) . ") signed with $mykeys[$i] $uids{$mykeys[$i]}->[0]\n";
 364         $num_myuids += @{$uids{$mykeys[$i]}};
 365 }
 366 my $i = 0;
 367 foreach my $mykey (@mykeys) {
 368         foreach my $myuid (@{$uids{$mykey}}) {
 369                 my $inc = defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
 370                 print WRITE "[" . ' 'x$i . 'S' . ' 'x($num_myuids-$i-1) . "] has signed $mykey $myuid\n";
 371                 $i++;
 372         }
 373 }
 374 close TXT;
 375
 376 if ($latex) {
 377         print WRITE <<'EOF';
 378 \end{alltt}
 379 \end{document}
 380 EOF
 381 }
 382
 383 close WRITE;
 384
 385 __END__
 386
 387 =head1 NAME
 388
 389 B<gpgsigs> - annotate list of GnuPG keys with already done signatures
 390
 391 =head1 SYNOPSIS
 392
 393 B<gpgsigs> [I<options>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
 394
 395 =head1 DESCRIPTION
 396
 397 B<gpgsigs> was written to assist the user in signing keys during a keysigning
 398 party. It takes as input a file containing keys in C<gpg --list-keys> format
 399 and prepends every line with a tag indicating if the user has already signed
 400 that uid. When the file contains C<MD5 Checksum:> or C<SHA1 Checksum:> lines
 401 and placeholders (C<__ __>), the checksum is inserted.
 402
 403 =head1 OPTIONS
 404
 405 =over
 406
 407 =item B<-r>
 408
 409 Call I<gpg --recv-keys> before creating the output.
 410
 411 =item B<-f> I<charset>
 412
 413 Convert F<keytxt> from I<charset>. The default is ISO-8859-1.
 414
 415 =item B<-t> I<charset>
 416
 417 Convert UIDs to I<charset>. The default is derived from LC_ALL, LC_CTYPE, and
 418 LANG, and if all these are unset, the default is ISO-8859-1.
 419
 420 =item B<--refresh>
 421
 422 Refresh the UID lists per key from gpg. Useful when UIDs were added or revoked
 423 since the input text was generated.
 424
 425 =item B<--latex>
 426
 427 Generate LaTeX output, including photo IDs. Implies B<--refresh>.
 428
 429 =item I<keyid>
 430
 431 Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
 432 by a comma (B<,>).
 433
 434 =item F<keytxt>
 435
 436 Read input from F<keytxt>.
 437
 438 =item F<outfile>
 439
 440 Write output to F<outfile>. Default is stdout.
 441
 442 =back
 443
 444 =head1 EXAMPLES
 445
 446 The following key signing parties are using B<gpgsigs>:
 447
 448 http://www.palfrader.org/ksp-lt2k4.html
 449
 450 http://www.palfrader.org/ksp-lt2k5.html
 451
 452 =head1 BUGS
 453
 454 B<GnuPG> is known to change its output format quite often. This version has
 455 been tested with gpg 1.2.5 and gpg 1.4.1. YMMV.
 456
 457 =head1 SEE ALSO
 458
 459 gpg(1), caff(1).
 460
 461 http://pgp-tools.alioth.debian.org/
 462
 463 =head1 AUTHORS AND COPYRIGHT
 464
 465 (c) 2004 Uli Martens <uli@youam.net>
 466
 467 (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
 468
 469 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb@df7cb.de>
 470
 471 =head1 LICENSE
 472
 473 All rights reserved.
 474
 475 Redistribution and use in source and binary forms, with or without
 476 modification, are permitted provided that the following conditions
 477 are met:
 478
 479 1. Redistributions of source code must retain the above copyright
 480 notice, this list of conditions and the following disclaimer.
 481
 482 2. Redistributions in binary form must reproduce the above copyright
 483 notice, this list of conditions and the following disclaimer in the
 484 documentation and/or other materials provided with the distribution.
 485
 486 3. The name of the author may not be used to endorse or promote products
 487 derived from this software without specific prior written permission.
 488
 489 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 490 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 491 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 492 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 493 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 494 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 495 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 496 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 497 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 498 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.