]> git.sthu.org Git - pgp-tools.git/blob - keylookup/keylookup
* Upgrade debhelper compatibility to the recommended level 5.
[pgp-tools.git] / keylookup / keylookup
1 #!/usr/bin/perl -w
2
3 # Copyright (c) 2000, 2002 Christian Kurz <shorty@debian.org>,
4 # Copyright (c) 2000, 2002, 2005 Peter Palfrader <peter@palfrader.org>
5 #
6 # $Id$
7 #
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2, or (at your option)
11 # any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software Foundation,
20 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21 #
22 # Keylookup is part of pgp-tools:
23 # http://pgp-tools.alioth.debian.org/
24 # svn://svn.debian.org/pgp-tools/trunk/
25 # http://svn.debian.org/wsvn/pgp-tools/trunk/
26
27 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'PATH'};
28 $|=1; # Always flush buffers
29
30
31 use strict;
32 use IO::Socket;
33 use IPC::Open3;
34 use Getopt::Long;
35
36 my $version = '3.0 ($Id$)';
37
38 # Where to find GnuPG's options file.
39 # Full path to the dialog and whiptail executeable.
40 my $Dialog = '/usr/bin/dialog';
41 my $Whiptail = '/usr/bin/whiptail';
42
43 # Strings to use in the dialog|whiptail frontend
44 my $TITLE = 'Import Keys';
45 my $BACKTITLE = 'KeyLookup $Revision$';
46 my $INSTRUCTION = 'Select keys to import:';
47 #
48 my @TPUTCOL=('tput', 'cols');
49 my @TPUTROW=('tput', 'lines');
50 my $DEFAULTCOLS = 80;
51 my $DEFAULTROWS = 25;
52 # Size of the dialog boxes, will be set in calcDialogSize;
53 my $MAX_UID_FIELD_LEN;
54 my @DIALOGSIZE;
55 my @WHIPTAILSIZE;
56
57
58 # Was the keyserver overriden|given on the command line?
59 # This is used to find out wheter we need to instruct the user
60 # to give the keyserver option to GnuPG.
61 my $keyserverWasSetOnCmdLine = 0;
62
63
64 # Maps algorithm numbers to algorithm types as defined in RFC 2400.
65 my %ALGOS = (
66 1 => 'R', # RSA
67 2 => 'r', # RSA encrypt only (deprecated)
68 3 => 's', # RSA sign only (deprecated)
69 16 => 'g', # ElGamal encrypt only
70 20 => 'g', # ElGamal sign and encrypt (all OpenPGP implementations cryptographically broken, do not use. no longer part of OpenPGP)
71 17 => 'D' # DSA
72 );
73
74
75 # getHits receives all options as a parameter, calls fetchIT to
76 # query a keyserver, processes the output from the keyserver and
77 # stores it in a datastructure for later use.
78 sub getHits($) {
79 my $options = shift;
80
81 my $pid = open(KID, '-|');
82 defined ($pid) or die ("Cannot fork: $!\n");
83 unless ($pid) {
84 close (STDIN);
85 open (STDIN, "/dev/null") || die ("Cannot open /dev/null as stdin: $!\n");
86
87 # child
88 my @ops = ('gpg');
89 if ($options->{'keyserver'}) {
90 push @ops, '--keyserver='.$options->{'keyserver'};
91 };
92 push @ops, '--command-fd=0';
93 push @ops, '--batch';
94 push @ops, '--no-tty';
95 push @ops, '--with-colons';
96 push @ops, '--fixed-list-mode';
97 push @ops, '--search';
98 push @ops, @{$options->{'search'}};
99 exec(@ops);
100 die ("Cannot exec GnuPG: $!\n");
101 };
102 my %keys;
103 my $currentKey;
104
105 while (<KID>) {
106 chomp;
107 my ($type, undef) = split /:/;
108 if ($type eq 'pub') {
109 my ($type, $keyid, $algo, $bits, $created, undef, $revoked) = split /:/;
110 $currentKey = { 'bits' => $bits,
111 'type' => (defined $ALGOS{$algo} ? $ALGOS{$algo} : '#'.$algo),
112 'keyid' => $keyid,
113 'created' => $created,
114 'revoked' => $revoked,
115 'uid' => []
116 };
117 $keys{ $keyid } = $currentKey;
118 } elsif (defined $currentKey && $type eq 'uid') {
119 my ($type, $name) = split /:/;
120 if ($currentKey->{'revoked'} eq 'r') {
121 $name .= ' [REVOKED]';
122 };
123 push @{ $currentKey->{'uid'} }, $name;
124 };
125 };
126 close KID;
127 waitpid $pid, 0;
128
129 return \%keys;
130 };
131
132 # returns the number of columns of the terminal
133 sub getCols {
134 my $pid;
135 return $DEFAULTCOLS unless (defined ($pid = open(KID, "-|")));
136 unless ($pid) {
137 exec (@TPUTCOL);
138 };
139 my $cols = <KID>;
140 close KID;
141 wait;
142 return (defined $cols) ? $cols : $DEFAULTCOLS;
143 };
144
145 # returns the number of lines of the terminal
146 sub getRows {
147 my $pid;
148 return $DEFAULTROWS unless (defined ($pid = open(KID, "-|")));
149 unless ($pid) {
150 exec (@TPUTROW);
151 };
152 my $rows = <KID>;
153 close KID;
154 wait;
155 return (defined $rows) ? $rows : $DEFAULTROWS;
156 };
157
158 # sets MAX_UID_FIELD_LEN, DIALOGSIZE, and WHIPTAILSIZE
159 sub calcDialogSize {
160 my $COLS = &getCols();
161 my $ROWS = &getRows();
162 $MAX_UID_FIELD_LEN = $COLS - 27;
163 @DIALOGSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
164 @WHIPTAILSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
165 }
166
167 sub prepareForDialog {
168 my $keys = shift;
169 my @keyargs = ();
170
171 for my $keyid (sort {- ($keys->{$a}->{'created'} <=> $keys->{$b}->{'created'})} keys %$keys) {
172 for (@{ $keys->{$keyid}->{'uid'} }) {
173 push @keyargs,
174 $keys->{$keyid}->{'keyid'},
175 length() <= $MAX_UID_FIELD_LEN ? $_ : substr($_, 0, $MAX_UID_FIELD_LEN-2) . '..',
176 'off';
177 };
178 my (undef,undef,undef,$mday,$mon,$year,undef,undef,undef) = localtime ($keys->{$keyid}->{'created'});
179 push @keyargs, $keys->{$keyid}->{'keyid'}, sprintf( "[created: %s-%s-%s]", $year+1900, $mon+1, $mday ), 'off';
180 push @keyargs, '-'x8, '-'x40, 'off';
181 };
182 pop @keyargs;
183 pop @keyargs;
184 pop @keyargs;
185
186 return \@keyargs;
187 };
188
189 sub prepareForTXT {
190 my $keys = shift;
191 my @lines = ();
192
193 for my $keyid (sort {- ($keys->{$a}->{'created'} <=> $keys->{$b}->{'created'})} keys %$keys) {
194 my (undef,undef,undef,$mday,$mon,$year,undef,undef,undef) = localtime ($keys->{$keyid}->{'created'});
195 push @lines, sprintf( "%s%s/%s %s-%s-%s\n",
196 $keys->{$keyid}->{'bits'},
197 $keys->{$keyid}->{'type'},
198 $keys->{$keyid}->{'keyid'},
199 $year+1900, $mon+1, $mday );
200 push @lines, map { ' 'x26 . $_ . "\n" } @{ $keys->{$keyid}->{'uid'} };
201 push @lines, "\n";
202 };
203
204 return \@lines;
205 };
206
207 sub callDialog {
208 my $args = shift;
209
210 # open(SAVEOUT, ">&STDOUT") || die ("Cannot save STDOUT: $!\n");
211 # open(SAVEIN , "<&STDIN" ) || die ("Cannot save STDIN: $!\n");
212
213 my $pid = open3( '<&STDIN', '>&STDOUT', \*ERRFH, @$args);
214
215 my %unique;
216 my @keys = grep { !$unique{$_}++ }
217 grep { /^[0-9A-Fa-f]{8}$/ }
218 map { s/\s//g; $_ } <ERRFH>;
219 wait;
220
221 # open(STDOUT, ">&SAVEOUT") || die "Cannot restore STDOUT: $!\n";
222 # open(STDIN , "<&SAVEIN") || die "Cannot restore STDIN: $!\n";
223
224 return \@keys;
225 };
226
227 sub selectKeys {
228 my $keys = shift;
229 my $options = shift;
230
231 my $frontend = $options->{'frontend'};
232 $frontend = 'dialog' unless (defined $frontend);
233
234 if ($frontend eq 'dialog') {
235 unless (-x $Dialog) {
236 warn("Dialog ($Dialog) not executeable/installed. Falling back to Whiptail\n");
237 $frontend = 'whiptail';
238 }
239 };
240 if ($frontend eq 'whiptail') {
241 unless (-x $Whiptail ) {
242 warn("Whiptail ($Whiptail) not executeable/installed. Falling back to plain\n");
243 $frontend = 'plain';
244 }
245 };
246
247 if ( $frontend eq 'dialog' ) {
248 calcDialogSize;
249 my @ARGS = (
250 $Dialog,
251 '--backtitle',
252 $BACKTITLE,
253 '--separate-output',
254 '--title',
255 $TITLE,
256 '--checklist',
257 $INSTRUCTION,
258 @DIALOGSIZE);
259 push @ARGS, @{&prepareForDialog($keys)};
260 return &callDialog( \@ARGS );
261 } elsif ( $frontend eq 'whiptail' ) {
262 calcDialogSize;
263 my @ARGS = (
264 $Whiptail,
265 '--backtitle',
266 $BACKTITLE,
267 '--separate-output',
268 '--title',
269 $TITLE,
270 '--checklist',
271 $INSTRUCTION,
272 @WHIPTAILSIZE,
273 '--');
274 push @ARGS, @{&prepareForDialog($keys)};
275 return &callDialog( \@ARGS );
276 } else {
277 print for (@{ &prepareForTXT( $keys ) });
278 if ($keyserverWasSetOnCmdLine) {
279 printf ("Now run gpg --keyserver %s --recv-keys <key ids>\n", $options->{'keyserver'});
280 } else {
281 print ("Now run gpg --recv-keys <key ids>\n");
282 };
283
284 ## If no frontend was selected, or selected frontend was plain,
285 ## exit successfully, otherwise with an exitcode != 0
286 exit (defined $options->{'frontend'} &&
287 $options->{'frontend'} ne "" &&
288 $options->{'frontend'} ne "plain");
289 };
290 };
291
292 sub importKeys {
293 my $keyids = shift;
294 my $options = shift;
295
296 my @args = ('gpg');
297 if ($options->{'keyserver'}) {
298 push @args, '--keyserver='.$options->{'keyserver'};
299 };
300 push @args, '--recv-keys';
301 for my $keyid (@$keyids) {
302 # untaint keyids
303 my ($cleanid) = $keyid =~ /^([a-zA-Z0-9]{8})$/;
304 warn ("keyid '$keyid' has unexpected format - skipping\n"), next
305 unless defined $cleanid;
306 push @args, $cleanid;
307 }
308
309 print "Calling GnuPG...\n";
310 exec (@args) || die "can't exec gnupg: $!\n"; # won't return
311 };
312
313
314 sub usage {
315 my $errorcode = shift;
316 print << 'EOF'
317 Syntax: keylookup [options] <searchstring>
318
319 Options:
320 --keyserver=<keyserver> Select keyserver
321 --frontend=<frontend> One of whiptail, dialog or plain
322 --importall Import all matched keys
323 --help print this message
324
325 EOF
326 ;
327 exit($errorcode);
328 };
329
330 sub version {
331 print "keylookup $version\nWritten by Christian Kurz and Peter Palfrader.\n";
332 exit(0);
333 };
334
335 my %options;
336 GetOptions( \%options,
337 'keyserver=s',
338 'frontend=s',
339 'importall',
340 'version',
341 'help') or
342 &usage(1);
343 &version(0) if ($options{'version'});
344 &usage(0) if ($options{'help'} || ( scalar(@ARGV) == 0));
345
346 ## Take all additional arguments to the program as a search target,
347 ## escape the string for use in URLs.
348 $options{'search'} = \@ARGV;
349 my $keys = getHits( \%options );
350 my $keyids;
351
352 if (scalar keys %$keys == 0) {
353 print "GnuPG did not find any keys matching your search string.\n";
354 exit 0;
355 };
356 if ($options{'importall'}) {
357 my @allkeys = keys %$keys;
358 $keyids = \@allkeys;
359 } else {
360 $keyids = selectKeys($keys, \%options); # won't return if no interactive frontend
361 };
362 &importKeys($keyids, \%options) if (scalar @$keyids); # won't return
363