keylookup/keylookup

   1 #!/usr/bin/perl -w
   2
   3 # (c) 2000, 2002 Christian Kurz <shorty@debian.org>,
   4 #                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 homepage: http://www.palfrader.org/keylookup/
  23 #           CVS, BTS: http://savannah.gnu.org/projects/keylookup/
  24
  25 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'PATH'};
  26 $|=1; # Always flush buffers
  27
  28
  29 use strict;
  30 use IO::Socket;
  31 use IPC::Open3;
  32 use Getopt::Long;
  33
  34 my $version = '2.1 ($Id$)';
  35
  36 # Where to find GnuPG's options file.
  37 # Full path to the dialog and whiptail executeable.
  38 my $Dialog = '/usr/bin/dialog';
  39 my $Whiptail = '/usr/bin/whiptail';
  40
  41 # Strings to use in the dialog|whiptail frontend
  42 my $TITLE = 'Import Keys';
  43 my $BACKTITLE = 'KeyLookup $Revision$';
  44 my $INSTRUCTION = 'Select keys to import:';
  45 #
  46 my @TPUTCOL=('tput', 'cols');
  47 my @TPUTROW=('tput', 'lines');
  48 my $DEFAULTCOLS = 80;
  49 my $DEFAULTROWS = 25;
  50 # Size of the dialog boxes, will be set in calcDialogSize;
  51 my $MAX_UID_FIELD_LEN;
  52 my @DIALOGSIZE;
  53 my @WHIPTAILSIZE;
  54
  55
  56 # Was the keyserver overriden|given on the command line?
  57 # This is used to find out wheter we need to instruct the user
  58 # to give the keyserver option to GnuPG.
  59 my $keyserverWasSetOnCmdLine = 0;
  60
  61
  62 # Maps algorithm numbers to algorithm types as defined in RFC 2400.
  63 my %ALGOS = (
  64                  1 => 'R',         # RSA
  65                  2 => 'r',         # RSA encrypt only  (deprecated)
  66                  3 => 's',         # RSA sign only (deprecated)
  67                  16 => 'g',        # ElGamal encrypt only
  68                  20 => 'g',        # ElGamal sign and encrypt (all OpenPGP implementations cryptographically broken, do not use.  no longer part of OpenPGP)
  69                  17 => 'D'         # DSA
  70             );
  71
  72
  73 # getHits receives all options as a parameter, calls fetchIT to
  74 # query a keyserver, processes the output from the keyserver and
  75 # stores it in a datastructure for later use.
  76 sub getHits($) {
  77         my $options = shift;
  78
  79         my $pid = open(KID, '-|');
  80         defined ($pid) or die ("Cannot fork: $!\n");
  81         unless ($pid) {
  82                 close (STDIN);
  83                 open (STDIN, "/dev/null") || die ("Cannot open /dev/null as stdin: $!\n");
  84
  85                 # child
  86                 my @ops = ('gpg');
  87                 if ($options->{'keyserver'}) {
  88                         push @ops, '--keyserver='.$options->{'keyserver'};
  89                 };
  90                 push @ops, '--command-fd=0';
  91                 push @ops, '--batch';
  92                 push @ops, '--no-tty';
  93                 push @ops, '--with-colons';
  94                 push @ops, '--fixed-list-mode';
  95                 push @ops, '--search';
  96                 push @ops, $options->{'search'};
  97                 exec(@ops);
  98                 die ("Cannot exec GnuPG: $!\n");
  99         };
 100         my %keys;
 101         my $currentKey;
 102
 103         while (<KID>) {
 104                 chomp;
 105                 my ($type, undef) = split /:/;
 106                 if ($type eq 'pub') {
 107                         my ($type, $keyid, $algo, $bits, $created, undef, $revoked) = split /:/;
 108                         my (undef,undef,undef,$mday,$mon,$year,undef,undef,undef) = localtime ($created);
 109                         $currentKey = { 'bits' => $bits,
 110                                         'type' => (defined $ALGOS{$algo} ? $ALGOS{$algo} : '#'.$algo),
 111                                         'keyid' => $keyid,
 112                                         'year' => $year+1900,
 113                                         'month' => $mon+1,
 114                                         'day' => $mday,
 115                                         'revoked' => $revoked,
 116                                         'uid' => []
 117                                       };
 118                         $keys{ $keyid } = $currentKey;
 119                 } elsif (defined $currentKey && $type eq 'uid') {
 120                         my ($type, $name) = split /:/;
 121                         if ($currentKey->{'revoked'} eq 'r') {
 122                                 $name .= ' [REVOKED]';
 123                         };
 124                         push @{ $currentKey->{'uid'} }, $name;
 125                 };
 126         };
 127         close KID;
 128         waitpid $pid, 0;
 129
 130         return \%keys;
 131 };
 132
 133 # returns the number of columns of the terminal
 134 sub getCols {
 135         my $pid;
 136         return $DEFAULTCOLS unless (defined ($pid = open(KID, "-|")));
 137         unless ($pid) {
 138                 exec (@TPUTCOL);
 139         };
 140         my $cols = <KID>;
 141         close KID;
 142         wait;
 143         return (defined $cols) ? $cols : $DEFAULTCOLS;
 144 };
 145
 146 # returns the number of lines of the terminal
 147 sub getRows {
 148         my $pid;
 149         return $DEFAULTROWS unless (defined ($pid = open(KID, "-|")));
 150         unless ($pid) {
 151                 exec (@TPUTROW);
 152         };
 153         my $rows = <KID>;
 154         close KID;
 155         wait;
 156         return (defined $rows) ? $rows : $DEFAULTROWS;
 157 };
 158
 159 # sets MAX_UID_FIELD_LEN, DIALOGSIZE, and WHIPTAILSIZE
 160 sub calcDialogSize {
 161         my $COLS = &getCols();
 162         my $ROWS = &getRows();
 163         $MAX_UID_FIELD_LEN = $COLS - 27;
 164         @DIALOGSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
 165         @WHIPTAILSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
 166 }
 167
 168 sub prepareForDialog {
 169         my $keys = shift;
 170         my @keyargs = ();
 171
 172         for my $keyid (keys %$keys) {
 173                 for (@{ $keys->{$keyid}->{'uid'} }) {
 174                         push @keyargs,
 175                                 $keys->{$keyid}->{'keyid'},
 176                                 length() <= $MAX_UID_FIELD_LEN ? $_ : substr($_, 0, $MAX_UID_FIELD_LEN-2) . '..',
 177                                 'off';
 178                 };
 179                 push @keyargs, '-'x8, '-'x40, 'off';
 180         };
 181         pop @keyargs;
 182         pop @keyargs;
 183         pop @keyargs;
 184
 185         return \@keyargs;
 186 };
 187
 188 sub prepareForTXT {
 189         my $keys = shift;
 190         my @lines = ();
 191
 192         for my $keyid (keys %$keys) {
 193                 push @lines, sprintf( "%s%s/%s %s-%s-%s\n",
 194                                       $keys->{$keyid}->{'bits'},
 195                                       $keys->{$keyid}->{'type'},
 196                                       $keys->{$keyid}->{'keyid'},
 197                                       $keys->{$keyid}->{'year'},
 198                                       $keys->{$keyid}->{'month'},
 199                                       $keys->{$keyid}->{'day'} );
 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'} = join ' ', @ARGV;
 349         $options{'search'} =~ s/ ( [^A-Za-z0-9] )
 350                                / '%' . unpack("H2", $1)
 351                                /xeg;
 352         my $keys = getHits( \%options );
 353         my $keyids;
 354
 355         if ($options{'importall'}) {
 356                 my @allkeys = keys %$keys;
 357                 $keyids = \@allkeys;
 358         } else {
 359                 $keyids = selectKeys($keys, \%options); # won't return if no interactive frontend
 360         };
 361         &importKeys($keyids, \%options) if (scalar @$keyids);   # won't return
 362