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