keylookup/keylookup

   1 #!/usr/bin/perl -Tw
   2
   3 # (c) 2000, 2002 Christian Kurz <shorty@debian.org>,
   4 #                Peter Palfrader <peter@palfrader.org>
   5 #
   6 # $Id: keylookup,v 1.34 2002/09/19 03:35:10 weasel Exp $
   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: keylookup,v 1.34 2002/09/19 03:35:10 weasel Exp $)';
  35
  36 # The port to use for keyservers unless given otherwise.
  37 my $PORT=11371;
  38 # The default proxy port which is used unless the port is explicitly given
  39 # in the http_proxy environment variable.
  40 my $PROXY_PORT=3128;
  41
  42 # Name of the GnuPG binary. The executeable must the in the PATH. This may
  43 # be overriden using the --gnupg= switch.
  44 my $GnuPG='gpg';
  45 # Where to find GnuPG's options file.
  46 my $GNUPGOPTIONS=(defined $ENV{GNUPGHOME} ? $ENV{GNUPGHOME} : $ENV{'HOME'}.'/.gnupg' ) . '/options';
  47 # Full path to the dialog and whiptail executeable.
  48 my $Dialog = '/usr/bin/dialog';
  49 my $Whiptail = '/usr/bin/whiptail';
  50
  51 # Strings to use in the dialog|whiptail frontend
  52 my $TITLE = 'Import Keys';
  53 my $BACKTITLE = 'KeyLookup $Revision: 1.34 $';
  54 my $INSTRUCTION = 'Select keys to import:';
  55 #
  56 my @TPUTCOL=('tput', 'cols');
  57 my @TPUTROW=('tput', 'lines');
  58 my $DEFAULTCOLS = 80;
  59 my $DEFAULTROWS = 25;
  60 # Size of the dialog boxes, will be set in calcDialogSize;
  61 my $MAX_UID_FIELD_LEN;
  62 my @DIALOGSIZE;
  63 my @WHIPTAILSIZE;
  64
  65
  66 # Was the keyserver overriden|given on the command line?
  67 # This is used to find out wheter we need to instruct the user
  68 # to give the keyserver option to GnuPG.
  69 my $keyserverWasSetOnCmdLine = 0;
  70
  71
  72 # Queries a remote keyserver (using a proxy if requested) and returns
  73 # the keyservers anser. No module is used deliberatly to make this
  74 # script run on as many systems as possible.
  75
  76 sub fetchIt($$$$) {
  77         my $server = shift;
  78         my $port = shift;
  79         my $requestURL = shift;
  80         my $honorproxy = shift;
  81
  82         my $result;
  83         my $remote;
  84
  85         if ($honorproxy && defined $ENV{'http_proxy'}) {
  86                 my $proxyserver;
  87                 my $proxyport;
  88
  89                 if ( $ENV{'http_proxy'} =~ m#^http://(\S+):(\d+)/?$# ) {
  90                         $proxyserver = $1;
  91                         $proxyport   = $2;
  92                 } elsif ( $ENV{'http_proxy'} =~ m#^http://(\S+)/?$# ) {
  93                         $proxyserver = $1;
  94                         $proxyport   = $PROXY_PORT;
  95                 } else {
  96                         die ("Unkown http_proxy format");
  97                 };
  98
  99                 $remote = IO::Socket::INET->new(
 100                         Proto           => 'tcp',
 101                         PeerAddr        => $proxyserver,
 102                         PeerPort        => $proxyport
 103                 ) || die ("Cannot connect to prox: $!");
 104
 105                 my $URL=sprintf("http://%s:%s%s/", $server, $port, $requestURL);
 106                 printf $remote "GET %s HTTP/1.1\n\n", $URL;
 107         } else {
 108                 $remote = IO::Socket::INET->new(
 109                         Proto           => 'tcp',
 110                         PeerAddr        => $server,
 111                         PeerPort        => $port
 112                 ) || die ("Cannot connect to keysever: $!");
 113
 114                 printf $remote "GET %s HTTP/1.1\nHost: %s\n\n\n", $requestURL, $server;
 115         };
 116
 117
 118         {
 119                 local $/;
 120                 $/=undef;
 121                 $result = <$remote>;
 122         };
 123         return $result;
 124 };
 125
 126
 127 # getHits receives all options as a parameter, calls fetchIT to
 128 # query a keyserver, processes the output from the keyserver and
 129 # stores it in a datastructure for later use.
 130 sub getHits($) {
 131         my $options = shift;
 132
 133         die ("$0: No keyserver given!\n") unless (defined $options->{'keyserver'});
 134
 135         my $result = fetchIt(
 136                 $options->{'keyserver'},
 137                 $options->{'port'},
 138                 sprintf("/pks/lookup?op=index&search=%s", $options->{'search'}),
 139                 $options->{'honor-http-proxy'}
 140         );
 141
 142         $result =~ s/<.*?>//g;
 143         $result =~ s/&gt;/>/g;
 144         $result =~ s/&lt;/</g;
 145         $result =~ s/&quot;/"/g;
 146         $result =~ s/&amp;/&/g;
 147
 148         my @lines = split (/\r?\n/, $result);
 149
 150         shift @lines;
 151         shift @lines;
 152         shift @lines;
 153         shift @lines;
 154
 155         my %keys;
 156         my $currentKey;
 157
 158         for (@lines) {
 159                 if (/^pub /) {
 160                         m, ^pub                 # pub at the start of the line
 161                            \s+                  # whitespace
 162                            (\d+)                # bits                  1024
 163                            ([A-Za-z]*)          # optional type (R or D usually) D
 164                            /                    # a slash
 165                            ([0-9A-Za-z]+)       # keyid                 94C09C7F
 166                            \s+                  # whitespace
 167                            (\d+)/(\d+)/(\d+)    # date                  1999/11/10
 168                            \s+                  # whitespace
 169                            (.*)                 # primary user id       Peter Palfrader
 170                            ,x or
 171                                 warn ("Unexpected format: $_\n"), next;
 172
 173                         $currentKey = { 'bits' => $1,
 174                                         'type' => $2,
 175                                         'keyid' => $3,
 176                                         'year' => $4,
 177                                         'month' => $5,
 178                                         'day' => $6,
 179                                         'uid' => [ $7 ]
 180                                       };
 181                         $keys{ $3 } = $currentKey;
 182                 } elsif (defined $currentKey) {
 183                         s/^\s+//;
 184                         push @{ $currentKey->{'uid'} }, $_;
 185                 };
 186         };
 187
 188         return \%keys;
 189 };
 190
 191 # returns the number of columns of the terminal
 192 sub getCols {
 193         my $pid;
 194         return $DEFAULTCOLS unless (defined ($pid = open(KID, "-|")));
 195         unless ($pid) {
 196                 exec (@TPUTCOL);
 197         };
 198         my $cols = <KID>;
 199         close KID;
 200         wait;
 201         return (defined $cols) ? $cols : $DEFAULTCOLS;
 202 };
 203
 204 # returns the number of lines of the terminal
 205 sub getRows {
 206         my $pid;
 207         return $DEFAULTROWS unless (defined ($pid = open(KID, "-|")));
 208         unless ($pid) {
 209                 exec (@TPUTROW);
 210         };
 211         my $rows = <KID>;
 212         close KID;
 213         wait;
 214         return (defined $rows) ? $rows : $DEFAULTROWS;
 215 };
 216
 217 # sets MAX_UID_FIELD_LEN, DIALOGSIZE, and WHIPTAILSIZE
 218 sub calcDialogSize {
 219         my $COLS = &getCols();
 220         my $ROWS = &getRows();
 221         $MAX_UID_FIELD_LEN = $COLS - 27;
 222         @DIALOGSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
 223         @WHIPTAILSIZE = ($ROWS-7, $COLS-7, $ROWS-14);
 224 }
 225
 226 sub prepareForDialog {
 227         my $keys = shift;
 228         my @keyargs = ();
 229
 230         for my $keyid (keys %$keys) {
 231                 for (@{ $keys->{$keyid}->{'uid'} }) {
 232                         push @keyargs,
 233                                 $keys->{$keyid}->{'keyid'},
 234                                 length() <= $MAX_UID_FIELD_LEN ? $_ : substr($_, 0, $MAX_UID_FIELD_LEN-2) . '..',
 235                                 'off';
 236                 };
 237                 push @keyargs, '-'x8, '-'x40, 'off';
 238         };
 239         pop @keyargs;
 240         pop @keyargs;
 241         pop @keyargs;
 242
 243         return \@keyargs;
 244 };
 245
 246 sub prepareForTXT {
 247         my $keys = shift;
 248         my @lines = ();
 249
 250         for my $keyid (keys %$keys) {
 251                 push @lines, sprintf( "%s%s/%s %s-%s-%s\n",
 252                                       $keys->{$keyid}->{'bits'},
 253                                       $keys->{$keyid}->{'type'},
 254                                       $keys->{$keyid}->{'keyid'},
 255                                       $keys->{$keyid}->{'year'},
 256                                       $keys->{$keyid}->{'month'},
 257                                       $keys->{$keyid}->{'day'} );
 258                 push @lines, map { ' 'x26 . $_ . "\n" } @{ $keys->{$keyid}->{'uid'} };
 259                 push @lines, "\n";
 260         };
 261
 262         return \@lines;
 263 };
 264
 265 sub callDialog {
 266         my $args = shift;
 267
 268         # open(SAVEOUT, ">&STDOUT") || die ("Cannot save STDOUT: $!\n");
 269         # open(SAVEIN , "<&STDIN" ) || die ("Cannot save STDIN: $!\n");
 270
 271         my $pid = open3( '<&STDIN', '>&STDOUT', \*ERRFH, @$args);
 272
 273         my %unique;
 274         my @keys = grep { !$unique{$_}++ }
 275                 grep { /^[0-9A-Fa-f]{8}$/ }
 276                 map { s/\s//g; $_ } <ERRFH>;
 277         wait;
 278
 279         # open(STDOUT, ">&SAVEOUT") || die "Cannot restore STDOUT: $!\n";
 280         # open(STDIN , "<&SAVEIN")  || die "Cannot restore STDIN: $!\n";
 281
 282         return \@keys;
 283 };
 284
 285 sub selectKeys {
 286         my $keys = shift;
 287         my $options = shift;
 288
 289         my $frontend = $options->{'frontend'};
 290         $frontend = 'dialog' unless (defined $frontend);
 291
 292         if ($frontend eq 'dialog') {
 293                 unless (-x $Dialog) {
 294                         warn("Dialog ($Dialog) not executeable/installed. Falling back to Whiptail\n");
 295                         $frontend = 'whiptail';
 296                 }
 297         };
 298         if ($frontend eq 'whiptail') {
 299                 unless (-x $Whiptail ) {
 300                         warn("Whiptail ($Whiptail) not executeable/installed. Falling back to plain\n");
 301                         $frontend = 'plain';
 302                 }
 303         };
 304
 305         if ( $frontend eq 'dialog' ) {
 306                 calcDialogSize;
 307                 my @ARGS = (
 308                         $Dialog,
 309                         '--backtitle',
 310                         $BACKTITLE,
 311                         '--separate-output',
 312                         '--title',
 313                         $TITLE,
 314                         '--checklist',
 315                         $INSTRUCTION,
 316                         @DIALOGSIZE);
 317                 push @ARGS, @{&prepareForDialog($keys)};
 318                 return &callDialog( \@ARGS );
 319         } elsif ( $frontend eq 'whiptail' ) {
 320                 calcDialogSize;
 321                 my @ARGS = (
 322                         $Whiptail,
 323                         '--backtitle',
 324                         $BACKTITLE,
 325                         '--separate-output',
 326                         '--title',
 327                         $TITLE,
 328                         '--checklist',
 329                         $INSTRUCTION,
 330                         @WHIPTAILSIZE,
 331                         '--');
 332                 push @ARGS, @{&prepareForDialog($keys)};
 333                 return &callDialog( \@ARGS );
 334         } else {
 335                 print for (@{ &prepareForTXT( $keys ) });
 336                 if ($keyserverWasSetOnCmdLine) {
 337                         printf ("Now run gpg --keyserver %s --recv-keys <key ids>\n", $options->{'keyserver'});
 338                 } else {
 339                         print ("Now run gpg --recv-keys <key ids>\n");
 340                 };
 341
 342                 ## If no frontend was selected, or selected frontend was plain,
 343                 ## exit successfully, otherwise with an exitcode != 0
 344                 exit (defined $options->{'frontend'} &&
 345                       $options->{'frontend'} ne "" &&
 346                       $options->{'frontend'} ne "plain");
 347         };
 348 };
 349
 350 sub importKeys {
 351         my $keyids = shift;
 352         my $options = shift;
 353
 354         my @args = ( $options->{'gnupg'},
 355                   '--keyserver',
 356                   $options->{'keyserver'},
 357                   '--recv-keys');
 358         for my $keyid (@$keyids) {
 359                 # untaint keyids
 360                 my ($cleanid) = $keyid =~ /^([a-zA-Z0-9]{8})$/;
 361                 warn ("keyid '$keyid' has unexpected format - skipping\n"), next
 362                         unless defined $cleanid;
 363                 push @args, $cleanid;
 364         }
 365
 366         print "Calling GnuPG...\n";
 367         exec (@args) || die "can't exec gnupg: $!\n"; # won't return
 368 };
 369
 370
 371 sub usage {
 372         my $errorcode = shift;
 373         print << 'EOF'
 374 Syntax: keylookup [options] <searchstring>
 375
 376 Options:
 377         --keyserver=<keyserver> Select keyserver
 378         --port=<port>           Use a non standard port
 379         --frontend=<frontend>   One of whiptail, dialog or plain
 380         --importall             Import all matched keys
 381         --gnupg=<gnupg>         use this gnupg binary
 382         --honor-http-proxy      honor the http_proxy environment varibale
 383         --help                  print this message
 384
 385 EOF
 386 ;
 387         exit($errorcode);
 388 };
 389
 390 sub version {
 391         print "keylookup $version\nWritten by Christian Kurz and Peter Palfrader.\n";
 392         exit(0);
 393 };
 394
 395         my %options;
 396         GetOptions( \%options,
 397                 'keyserver=s',
 398                 'port=i',
 399                 'frontend=s',
 400                 'importall',
 401                 'gnupg=s',
 402                 'honor-http-proxy',
 403                 'version',
 404                 'help') or
 405                 &usage(1);
 406         &version(0) if ($options{'version'});
 407         &usage(0) if ($options{'help'} || ( scalar(@ARGV) == 0));
 408
 409         ## If the keyserver was not given on the command line, lurk into
 410         ## GnuPG's config file, it might be defined there.
 411         $keyserverWasSetOnCmdLine = defined $options{'keyserver'};
 412         unless (defined $options{'keyserver'} &&
 413                 defined $options{'honor-http-proxy'} ) {
 414                 if ( open(GNUPGOPTIONS, $GNUPGOPTIONS) ) {
 415                         my $keyserver = $options{'keyserver'};
 416                         while (<GNUPGOPTIONS>) {
 417                                 $options{'keyserver'} = $1 if (/^\s*keyserver\s+(\S+?)[#\s]/i && ! defined $keyserver);
 418                                 $options{'honor-http-proxy'} = 1 if /^\s*(keyserver-options\s+)honor-http-proxy\s/i;
 419                         };
 420                         close(GNUPGOPTIONS) || warn("Cannot close $GNUPGOPTIONS: $!\n");
 421                 } else {
 422                         warn ("Cannot open $GNUPGOPTIONS: $!\n");
 423                 };
 424         };
 425         $options{'port'}  = $PORT unless (defined $options{'port'});
 426         $options{'gnupg'} = $GnuPG unless (defined $options{'gnupg'});
 427
 428         # Untaint it
 429         $options{'keyserver'} =~ /(.*)/;
 430         $options{'keyserver'} = $1;
 431
 432         ## Take all additional arguments to the program as a search target,
 433         ## escape the string for use in URLs.
 434         $options{'search'} = join ' ', @ARGV;
 435         $options{'search'} =~ s/ ( [^A-Za-z0-9] )
 436                                / '%' . unpack("H2", $1)
 437                                /xeg;
 438         my $keys = getHits( \%options );
 439         my $keyids;
 440
 441         if ($options{'importall'}) {
 442                 my @allkeys = keys %$keys;
 443                 $keyids = \@allkeys;
 444         } else {
 445                 $keyids = selectKeys($keys, \%options); # won't return if no interactive frontend
 446         };
 447         &importKeys($keyids, \%options) if (scalar @$keyids);   # won't return
 448