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