]> git.sthu.org Git - pgp-tools.git/blob - gpgsigs/gpgsigs
Checked for policy 3.8.1, no changes necessary.
[pgp-tools.git] / 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 # see the Debian changelog for further changes.
21
22 my $VERSION = qq$Rev$;
23 $ENV{PATH} .= ":/usr/share/signing-party";
24
25 use strict;
26 use warnings;
27 use English;
28 use IPC::Open3;
29 use Getopt::Long;
30
31
32 sub version($)
33 {
34 my ($fd) = @_;
35
36 print $fd <<EOF;
37 gpgsigs $VERSION- http://pgp-tools.alioth.debian.org/
38 (c) 2004 Uli Martens <uli\@youam.net>
39 (c) 2004, 2005 Peter Palfrader <peter\@palfrader.org>
40 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb\@df7cb.de>
41 EOF
42 }
43
44 sub usage($$)
45 {
46 my ($fd, $error) = @_;
47
48 version($fd);
49 print $fd <<EOF;
50
51 Usage: $PROGRAM_NAME [-r] [-t <charset>] <keyid> <keytxt> [<outfile>]
52
53 keyid is a long or short keyid (e.g. DE7AAF6E94C09C7F or 94C09C7F)
54 separate multiple keyids with ','
55 -r call gpg --recv-keys before proceeding
56 -f <charset> convert <keytxt> from charset
57 -t <charset> convert UIDs to charset in output
58 --refresh regenerate UID lists on keys
59 --latex generate LaTeX output including photo IDs
60 EOF
61 exit $error;
62 }
63
64
65 my ($fromcharset, $charset, $recv_keys, $refresh, $latex);
66 Getopt::Long::config('bundling');
67 GetOptions(
68 '-f=s' => \$fromcharset,
69 '-t=s' => \$charset,
70 r => \$recv_keys,
71 refresh => \$refresh,
72 latex => \$latex,
73 help => sub { usage(*STDOUT, 0); },
74 version => sub { version(*STDOUT); exit 0;},
75 ) or usage(*STDERR, 1);
76
77
78 # charset conversion
79 $fromcharset ||= "ISO-8859-1";
80 $charset ||= $ENV{LC_ALL} || $ENV{LC_CTYPE} || $ENV{LANG} || "ISO-8859-1";
81 $charset = "ISO-8859-1" unless $charset =~ /[\.-]/;
82 $charset =~ s/.*\.//;
83 $charset =~ s/@.*//;
84
85
86 sub myrecode($$$) {
87 my ($text, $from, $to) = @_;
88
89 if (eval "require Locale::Recode") {
90 my $rt = Locale::Recode->new (from => $from, to => $to);
91
92 my $orig = $text;
93 $rt->recode($text);
94 return $text;
95 } elsif (eval "require Text::Iconv") {
96 my $it = Text::Iconv->new($from, $to);
97
98 my $result = $it->convert($text);
99 warn ("Could not convert '$text'\n") unless defined $result;
100 return (defined $result) ? $result : $text
101 } else {
102 my $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH, 'recode', "utf8..$charset");
103 print WTRFH $text;
104 close WTRFH;
105 local $/ = undef;
106 my $result = <RDRFH>;
107 close RDRFH;
108 close ERRFH;
109 waitpid $pid, 0;
110 warn ("'recode' failed, is it installed?\n") unless defined $result;
111 return (defined $result) ? $result : $text
112 }
113 }
114
115
116 # parse options
117 my @mykeys = split /,/, uc(shift @ARGV);
118 my $keytxt = (shift @ARGV) || usage(*STDERR, 1);
119 my $outfile = (shift @ARGV) || '-';
120
121 map { s/^0x//i; } @mykeys;
122 my %uids = map { $_ => [] } @mykeys;
123
124 if (!@mykeys || scalar @ARGV) {
125 usage(*STDERR, 1);
126 }
127 foreach my $falsekey (grep { $_ !~ /^([0-9A-F]{16,16}|[0-9A-F]{8,8})$/ } @mykeys) {
128 print STDERR "Invalid keyid $falsekey given\n";
129 usage(*STDERR, 1);
130 }
131
132 -r $keytxt or die ("$keytxt does not exist\n");
133
134
135 # get list of keys in file
136 my @keys;
137 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
138 while (<TXT>) {
139 if ( m/^pub +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
140 push @keys, $1;
141 }
142 }
143 close TXT;
144
145
146 # get all known signatures
147 if ($recv_keys) {
148 print STDERR "Requesting keys from keyserver\n";
149 system "gpg --recv-keys @keys";
150 }
151
152 print STDERR "Running --list-sigs, this will take a while ";
153 open SIGS, "gpg --fixed-list-mode --with-colons --list-sigs @mykeys @keys 2>/dev/null |"
154 or die "can't get gpg listing";
155
156 my ($key, $uid, $sigs, $photocount);
157 while (<SIGS>) {
158 if ( m/^pub:(?:.*?:){3,3}([0-9A-F]{16,16}):/ ) {
159 $key = $1;
160 print STDERR ".";
161 undef $photocount;
162 next;
163 }
164 if ( m/^uid:(.):(?:.*?:){7,7}(.*):/s ) {
165 my $uidstatus = $1;
166 $uid = $2;
167 $uid =~ s/\\x([0-9a-f][0-9a-f])/ chr(hex($1)) /gie;
168 $uid = myrecode($uid, "UTF-8", $charset);
169
170 my ($shortkey) = substr $key, -8;
171 # Remember non-revoked uids
172 next if $uidstatus eq "r";
173 push @{$uids{$shortkey}}, $uid;
174 next;
175 }
176 if ( m/^uat:(.)::::[^:]+::([0-9A-F]+)::\d+ (\d+)/ ) { # uat:-::::2006-08-03::27BAEAF742BD253C2F3F03B043DC1536880193C4::1 7993:
177 my $uidstatus = $1;
178 # $2 is hash of attribute data
179 my $size = $3 - 19; # FIXME: find a nicer way to find out picture size
180 $uid = "[jpeg image of size $size]";
181 next if $uidstatus eq "r";
182 if ($latex and not $photocount) { # call once per key
183 my ($shortkey) = substr $key, -8;
184 system "rm $shortkey.[1-9]*.eps";
185 system "gpg --photo-viewer 'gpgsigs-eps-helper $shortkey' --list-options show-photos --list-key $key > /dev/null";
186 $photocount = 1;
187 }
188 my ($shortkey) = substr $key, -8;
189 push @{$uids{$shortkey}}, $uid;
190 next;
191 }
192 if ( m/^sig:(?:.*?:){3,3}([0-9A-F]{8})([0-9A-F]{8}):(?:.*?:){5,5}(.*?):/ ) {
193 my $class = $3;
194 if ($class eq '10x') {
195 $class = 'S';
196 } elsif ($class eq '11x') {
197 $class = '1';
198 } elsif ($class eq '12x') {
199 $class = '2';
200 } elsif ($class eq '13x') {
201 $class = '3';
202 } else {
203 $class = 's';
204 };
205 # Handle the case where one UID was signed multiple times
206 # with different signature classes.
207 my $before = $sigs->{$key}->{$uid}->{$1.$2};
208 if (defined $before) {
209 if ($before eq 'S' || $before eq 's') {
210 $sigs->{$key}->{$uid}->{$1.$2} = $class;
211 } elsif ($class eq 'S' || $class eq 's') {
212 # intentionally left blank
213 } elsif ($before < $class) {
214 $sigs->{$key}->{$uid}->{$1.$2} = $class;
215 };
216 } else {
217 $sigs->{$key}->{$uid}->{$1.$2} .= $class;
218 };
219 $sigs->{$key}->{$uid}->{$2} = $sigs->{$key}->{$uid}->{$1.$2};
220 next;
221 }
222 next if ( m/^(rev|rvk|sub|tru):/ ); # revoke/revoker/subkey/trust
223 warn "unknown value: '$_', key: ".(defined $key ? $key :'none')."\n";
224 }
225 close SIGS;
226 print STDERR "\n";
227
228 for my $k ( keys %{$sigs} ) {
229 if ( $k =~ m/^[0-9A-F]{8}([0-9A-F]{8})$/ ) {
230 $sigs->{$1} = $sigs->{$k};
231 }
232 }
233
234
235 # read checksums
236 open MD, "gpg --with-colons --print-md md5 $keytxt|" or warn "can't get gpg md5\n";
237 my $MD5 = <MD>;
238 close MD;
239 open MD, "gpg --with-colons --print-md sha1 $keytxt|" or warn "can't get gpg sha1\n";
240 my $SHA1 = <MD>;
241 close MD;
242 open MD, "gpg --with-colons --print-md sha256 $keytxt|" or warn "can't get gpg sha256\n";
243 my $SHA256 = <MD>;
244 close MD;
245
246 my @MD5 = split /:/, $MD5;
247 my @SHA1 = split /:/, $SHA1;
248 my @SHA256 = split /:/, $SHA256;
249 $MD5 = $MD5[2];
250 $SHA1 = $SHA1[2];
251 $SHA256 = $SHA256[2];
252
253 $MD5 =~ s/(.{16})/$1 /;
254 $SHA1 =~ s/(.{20})/$1 /;
255 $SHA256 =~ s/(.{32})/$1 /;
256 $MD5 =~ s/([0-9A-Z]{2})/$1 /ig;
257 $SHA1 =~ s/([0-9A-Z]{4})/$1 /ig;
258 $SHA256 =~ s/([0-9A-Z]{4})/$1 /ig;
259
260 chomp $MD5;
261 chomp $SHA1;
262 chomp $SHA256;
263 my $metatxt = quotemeta($keytxt);
264 $MD5 =~ s/^$metatxt:\s*//;
265 $SHA1 =~ s/^$metatxt:\s*//;
266 $SHA256 =~ s/^$metatxt:\s*//;
267
268
269 # write out result
270 sub print_tag
271 {
272 my ($key, $uid) = @_;
273 if (! defined $sigs->{$key}->{$uid}) {
274 warn "uid '$uid' not found on key $key\n";
275 #for (keys %{ $sigs->{$key} }) {
276 # print STDERR "only have $_\n";
277 #};
278 return '(' . (' ' x @mykeys) . ')';
279 }
280 my $r = '(';
281 foreach my $mykey (@mykeys) {
282 $r .= defined $sigs->{$key}->{$uid}->{$mykey} ? $sigs->{$key}->{$uid}->{$mykey} : ' ';
283 }
284 $r .= ')';
285 return $r;
286 }
287
288 $key = undef;
289 $uid = undef;
290 my $line = 0;
291 print STDERR "Annotating $keytxt, writing into $outfile\n";
292 open (TXT, $keytxt) or die ("Cannot open $keytxt\n");
293 open (WRITE, '>'.$outfile) or die ("Cannot open $outfile for writing\n");
294
295 if ($latex) {
296 print WRITE <<'EOF';
297 \documentclass{article}
298 \usepackage[margin=2cm]{geometry}
299 \usepackage{alltt}
300 \usepackage{graphicx}
301 \begin{document}
302 \begin{alltt}
303 EOF
304 }
305
306 while (<TXT>) {
307 $line++;
308 $_ = myrecode($_, $fromcharset, $charset);
309 if (/^MD5 Checksum:/ && defined $MD5) {
310 s/[_[:xdigit:]][_ [:xdigit:]]+_/$MD5/;
311 }
312 if (/^SHA1 Checksum:/ && defined $SHA1) {
313 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA1/;
314 }
315 if (/^SHA256 Checksum:/ && defined $SHA256) {
316 s/[_[:xdigit:]][_ [:xdigit:]]+_/$SHA256/;
317 }
318 if ( m/^pub +(?:\d+)[DR]\/([0-9A-F]{8}) [0-9]{4}-[0-9]{2}-[0-9]{2} *(.*)/ ) {
319 $key = $1;
320 $uid = $2;
321 #if ($uid) { # in gpg 1.2, the first uid is here
322 # print WRITE print_tag($key, $uid) . " $_";
323 # next;
324 #}
325 print WRITE;
326 undef $photocount;
327 next;
328 }
329
330 if ( m/^ *Key fingerprint/ ) {
331 print WRITE;
332 my $inc = "";
333 foreach my $mykey (@mykeys) {
334 foreach my $myuid (@{$uids{$mykey}}) {
335 $inc .= defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
336 }
337 }
338 print WRITE "[$inc] incoming signatures\n" if $inc =~ /\S/;
339 if ($refresh or $latex) {
340 foreach $uid (@{$uids{$key}}) {
341 print WRITE print_tag($key, $uid) . " $uid\n";
342 if ($latex and ($uid =~ /^\[jpeg image/)) {
343 $photocount++;
344 print WRITE "\\begin{flushright}\n";
345 print WRITE "\\includegraphics[height=3cm]{$key.$photocount.eps}\n";
346 print WRITE "\\end{flushright}\n";
347 }
348 }
349 }
350 next;
351
352 }
353 if ( m/^uid +(.*)$/ ) {
354 $uid = $1;
355 next if $refresh or $latex;
356 unless (defined $key) {
357 warn "key is undefined - input text is possibly malformed near line $line\n";
358 next;
359 };
360 die "bad tag from $key | $uid" unless defined (print_tag($key, $uid));
361 print WRITE print_tag($key, $uid) . " $_";
362 next;
363 }
364 print WRITE;
365 }
366
367 print WRITE "Legend:\n";
368 my $num_myuids = 0;
369 foreach my $i (0 .. @mykeys - 1) {
370 print WRITE '(' . ' 'x$i . 'S' . ' 'x(@mykeys-$i-1) . ") signed with $mykeys[$i] $uids{$mykeys[$i]}->[0]\n";
371 $num_myuids += @{$uids{$mykeys[$i]}};
372 }
373 my $i = 0;
374 foreach my $mykey (@mykeys) {
375 foreach my $myuid (@{$uids{$mykey}}) {
376 my $inc = defined $sigs->{$mykey}->{$myuid}->{$key} ? $sigs->{$mykey}->{$myuid}->{$key} : ' ';
377 print WRITE "[" . ' 'x$i . 'S' . ' 'x($num_myuids-$i-1) . "] has signed $mykey $myuid\n";
378 $i++;
379 }
380 }
381 close TXT;
382
383 if ($latex) {
384 print WRITE <<'EOF';
385 \end{alltt}
386 \end{document}
387 EOF
388 }
389
390 close WRITE;
391
392 __END__
393
394 =head1 NAME
395
396 B<gpgsigs> - annotate list of GnuPG keys with already done signatures
397
398 =head1 SYNOPSIS
399
400 B<gpgsigs> [I<options>] I<keyid>I<[>B<,>I<keyidI<[>B<,>I<...>I<]>>I<]> F<keytxt> [F<outfile>]
401
402 =head1 DESCRIPTION
403
404 B<gpgsigs> was written to assist the user in signing keys during a keysigning
405 party. It takes as input a file containing keys in C<gpg --list-keys> format
406 and prepends every line with a tag indicating if the user has already signed
407 that uid. When the file contains C<MD5 Checksum:> or C<SHA1 Checksum:> lines
408 and placeholders (C<__ __>), the checksum is inserted.
409
410 =head1 OPTIONS
411
412 =over
413
414 =item B<-r>
415
416 Call I<gpg --recv-keys> before creating the output.
417
418 =item B<-f> I<charset>
419
420 Convert F<keytxt> from I<charset>. The default is ISO-8859-1.
421
422 =item B<-t> I<charset>
423
424 Convert UIDs to I<charset>. The default is derived from LC_ALL, LC_CTYPE, and
425 LANG, and if all these are unset, the default is ISO-8859-1.
426
427 =item B<--refresh>
428
429 Refresh the UID lists per key from gpg. Useful when UIDs were added or revoked
430 since the input text was generated.
431
432 =item B<--latex>
433
434 Generate LaTeX output, including photo IDs. Implies B<--refresh>.
435 B<Note:> This writes eps files to the current directory.
436
437 =item I<keyid>
438
439 Use this keyid (8 or 16 byte) for annotation. Multiple keyids can be separated
440 by a comma (B<,>).
441
442 =item F<keytxt>
443
444 Read input from F<keytxt>.
445
446 =item F<outfile>
447
448 Write output to F<outfile>. Default is stdout.
449
450 =back
451
452 =head1 EXAMPLES
453
454 The following key signing parties are using B<gpgsigs>:
455
456 http://www.palfrader.org/ksp-lt2k4.html
457
458 http://www.palfrader.org/ksp-lt2k5.html
459
460 =head1 BUGS
461
462 B<GnuPG> is known to change its output format quite often. This version has
463 been tested with gpg 1.2.5 and gpg 1.4.1. YMMV.
464
465 =head1 SEE ALSO
466
467 gpg(1), caff(1).
468
469 http://pgp-tools.alioth.debian.org/
470
471 =head1 AUTHORS AND COPYRIGHT
472
473 (c) 2004 Uli Martens <uli@youam.net>
474
475 (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
476
477 (c) 2004, 2005, 2006, 2007 Christoph Berg <cb@df7cb.de>
478
479 =head1 LICENSE
480
481 All rights reserved.
482
483 Redistribution and use in source and binary forms, with or without
484 modification, are permitted provided that the following conditions
485 are met:
486
487 1. Redistributions of source code must retain the above copyright
488 notice, this list of conditions and the following disclaimer.
489
490 2. Redistributions in binary form must reproduce the above copyright
491 notice, this list of conditions and the following disclaimer in the
492 documentation and/or other materials provided with the distribution.
493
494 3. The name of the author may not be used to endorse or promote products
495 derived from this software without specific prior written permission.
496
497 THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
498 IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
499 OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
500 IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
501 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
502 NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
503 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
504 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
505 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
506 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.