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 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
 119 if (!@mykeys || scalar @ARGV) {
 120         usage(*STDERR, 1);
 121 }
 122 foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
 123         print STDERR "Invalid keyid $falsekey given\n";
 124         usage(*STDERR, 1);
 125 }
 126
 127 -r $keytxt or die ("$keytxt does not exist\n");
 128
 129
 130 # get list of keys in file
 131 my @keys;
 132 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
 133 while (<TXT>) {
 134         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 135                 push @keys, $1;
 136         }
 137 }
 138 close TXT;
 139
 140
 141 # get all known signatures
 142 if ($recv_keys) {
 143         print STDERR "Requesting keys from keyserver\n";
 144         system "gpg --recv-keys @keys";
 145 }
 146
 147 print STDERR "Running --list-sigs, this will take a while ";
 148 open SIGS, "gpg --fixed-list-mode --with-colons --list-sigs @keys 2>/dev/null |"
 149         or die "can't get gpg listing";
 150
 151 my ($key, $uid, $sigs);
 152 while (<SIGS>) {
 153         if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
 154                 $key = $1;
 155                 print STDERR ".";
 156                 next;
 157         }
 158         if ( m/^uid:(?:.*?:){8,8}(.*):/s ) {
 159                 $uid = $1;
 160                 $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
 161                 $uid = myrecode($uid, "UTF-8", $charset);
 162                 next;
 163         }
 164         if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
 165                 my $class = $3;
 166                 if ($class eq '10x') {
 167                         $class = 'S';
 168                 } elsif ($class eq '11x') {
 169                         $class = '1';
 170                 } elsif ($class eq '12x') {
 171                         $class = '2';
 172                 } elsif ($class eq '13x') {
 173                         $class = '3';
 174                 } else {
 175                         $class = 's';
 176                 };
 177                 # Handle the case where one UID was signed multiple times
 178                 # with different signature classes.
 179                 my $before = $sigs->{$key}->{$uid}->{$1.$2};
 180                 if (defined $before) {
 181                         if ($before eq 'S' || $before eq 's') {
 182                                 $sigs->{$key}->{$uid}->{$1.$2} = $class;
 183                         } elsif ($class eq 'S' || $class eq 's') {
 184                                 # intentionall left blank
 185                         } elsif ($before < $class) {
 186                                 $sigs->{$key}->{$uid}->{$1.$2} = $class;
 187                         };
 188                 } else {
 189                         $sigs->{$key}->{$uid}->{$1.$2} .= $class;
 190                 };
 191                 $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
 192                 next;
 193         }
 194         if ( m/^uat:/ ) {
 195                 $uid = "Photo ID";
 196                 next;
 197         }
 198         next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
 199         warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
 200 }
 201 close SIGS;
 202 print STDERR "\n";
 203
 204 for my $k ( keys %{$sigs} ) {
 205         if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
 206                 $sigs->{$1} = $sigs->{$k};
 207         }
 208 }
 209
 210
 211 # read checksums
 212 open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
 213 my $MD5 = <MD>;
 214 close MD;
 215 open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
 216 my $SHA1 = <MD>;
 217 close MD;
 218
 219 my @MD5 = split /:/, $MD5;
 220 my @SHA1 = split /:/, $SHA1;
 221 $MD5 = $MD5[2];
 222 $SHA1 = $SHA1[2];
 223
 224 $MD5 =~ s/(.{16})/$1 /;
 225 $SHA1 =~ s/(.{20})/$1 /;
 226 $MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
 227 $SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
 228
 229 chomp $MD5;
 230 chomp $SHA1;
 231 my $metatxt = quotemeta($keytxt);
 232 $MD5 =~ s/^$metatxt:\s*//;
 233 $SHA1 =~ s/^$metatxt:\s*//;
 234
 235
 236 # write out result
 237 sub print_tag
 238 {
 239         my ($key, $uid) = @_;
 240         if (! defined $sigs->{$key}->{$uid}) {
 241                 warn "uid '$uid' not found on key $key\n";
 242                 #for (keys %{ $sigs->{$key} }) {
 243                 #       print STDERR "only have $_\n";
 244                 #};
 245                 return '(' . (' ' x @mykeys) . ')';
 246         }
 247         my $r = '(';
 248         foreach my $mykey (@mykeys) {
 249                 $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
 250         }
 251         $r .= ')';
 252         return $r;
 253 }
 254
 255 $key = undef;
 256 $uid = undef;
 257 my $line = 0;
 258 print STDERR "Annotating $keytxt, writing into $outfile\n";
 259 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
 260 open (WRITE, '>'.$outfile) or die ("Cannot open $outfile for writing\n");
 261 while (<TXT>) {
 262         $line++;
 263         $_ = myrecode($_, $fromcharset, $charset);
 264         if (/^MD5 Checksum:/ && defined $MD5) {
 265                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
 266         }
 267         if (/^SHA1 Checksum:/ && defined $SHA1) {
 268                 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
 269         }
 270         if ( m/^pub  +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
 271                 $key = $1;
 272                 $uid = $2;
 273                 #if ($uid) { # in gpg 1.2, the first uid is here
 274                 #       print WRITE print_tag($key, $uid) . " $_";
 275                 #       next;
 276                 #}
 277         }
 278         if ( m/^uid +(.*)$/ ) {
 279                 $uid = $1;
 280                 unless (defined $key) {
 281                         warn "key is undefined - input text is possibly malformed near line $line\n";
 282                         next;
 283                 };
 284                 die "uid is undefined, key $key" unless defined $uid;
 285                 die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
 286                 print WRITE print_tag($key, $uid) . " $_";
 287                 next;
 288         }
 289         print WRITE;
 290 }
 291
 292 print WRITE "Legend:\n";
 293 foreach my $i (0 .. @mykeys - 1) {
 294         print WRITE '('. ' 'x$i . 'S' . ' 'x(@mykeys-$i-1) . ") signed with $mykeys[$i]\n";
 295 }
 296 close TXT;
 297
 298 __END__
 299
 300 =head1 NAME
 301
 302 B<gpgsigs> - annotate list of GnuPG keys with already done signatures
 303
 304 =head1 SYNOPSIS
 305
 306 B<gpgsigs> [-r] [-f I<charset>] [-t I<charset>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
 307
 308 =head1 DESCRIPTION
 309
 310 B<gpgsigs> was written to assist the user in signing keys during a keysigning
 311 party. It takes as input a file containing keys in C<gpg --list-keys> format
 312 and prepends every line with a tag indicating if the user has already signed
 313 that uid. When the file contains C<MD5 Checksum:> or C<SHA1 Checksum:> lines
 314 and placeholders (C<__ __>), the checksum is inserted.
 315
 316 =head1 OPTIONS
 317
 318 =over
 319
 320 =item -r
 321
 322 Call I<gpg --recv-keys> before creating the output.
 323
 324 =item -f I<charset>
 325
 326 Convert F<keytxt> from I<charset>. The default is ISO-8859-1.
 327
 328 =item -t I<charset>
 329
 330 Convert UIDs to I<charset>. The default is derived from LC_ALL, LC_CTYPE, and
 331 LANG, and if all these are unset, the default is ISO-8859-1.
 332
 333 =item I<keyid>
 334
 335 Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
 336 by a comma (B<,>).
 337
 338 =item F<keytxt>
 339
 340 Read input from F<keytxt>.
 341
 342 =item F<outfile>
 343
 344 Write output to F<outfile>. Default is stdout.
 345
 346 =back
 347
 348 =head1 EXAMPLES
 349
 350 The following key signing parties are using B<gpgsigs>:
 351
 352 http://www.palfrader.org/ksp-lt2k4.html
 353
 354 http://www.palfrader.org/ksp-lt2k5.html
 355
 356 =head1 BUGS
 357
 358 B<GnuPG> is known to change its output format quite often. This version has
 359 been tested with gpg 1.2.5 and gpg 1.4.1. YMMV.
 360
 361 =head1 SEE ALSO
 362
 363 gpg(1), caff(1).
 364
 365 http://pgp-tools.alioth.debian.org/
 366
 367 =head1 AUTHORS AND COPYRIGHT
 368
 369 (c) 2004 Uli Martens <uli@youam.net>
 370
 371 (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
 372
 373 (c) 2004, 2005, 2006 Christoph Berg <cb@df7cb.de>
 374
 375 =head1 LICENSE
 376
 377 All rights reserved.
 378
 379 Redistribution and use in source and binary forms, with or without
 380 modification, are permitted provided that the following conditions
 381 are met:
 382
 383 1. Redistributions of source code must retain the above copyright
 384 notice, this list of conditions and the following disclaimer.
 385
 386 2. Redistributions in binary form must reproduce the above copyright
 387 notice, this list of conditions and the following disclaimer in the
 388 documentation and/or other materials provided with the distribution.
 389
 390 3. The name of the author may not be used to endorse or promote products
 391 derived from this software without specific prior written permission.
 392
 393 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 394 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 395 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 396 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 397 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 398 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 399 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 400 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 401 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 402 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.