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