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