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