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