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