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