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