gpgsigs/gpgsigs

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