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