gpgkeys_hkpms

   1 #!/usr/bin/perl -w
   2
   3 # hkpms transport -- HKP-over-TLS, authenticated by monkeysphere
   4
   5 use strict;
   6 use warnings;
   7
   8
   9
  10 # Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
  11 # Copyright: 2010
  12 # License: GPL v3+
  13 #          (you should have received a COPYING file with this distribution)
  14
  15
  16
  17
  18 { package Crypt::Monkeysphere::MSVA::HKPMS;
  19   use POSIX;
  20   use Crypt::Monkeysphere::Logger;
  21   use Crypt::Monkeysphere::MSVA::Client;
  22   use Regexp::Common qw /net/;
  23   use Module::Load::Conditional;
  24
  25   sub parse_input {
  26     my $self = shift;
  27     my $input = shift;
  28
  29     my $inheaders = 1;
  30     foreach my $line (split(/\n/, $input)) {
  31       if ($inheaders) {
  32         if ($line eq '') {
  33           $inheaders = 0;
  34         } else {
  35           next if ($line =~ /^#/);
  36           my @args = split(/ /, $line);
  37           my $cmd = shift @args;
  38           $self->{config}->{lc($cmd)} = join(' ', @args);
  39           if (lc($cmd) eq 'option') {
  40             my $opt = lc($args[0]);
  41             if ($opt eq 'debug') {
  42               $self->{logger}->set_log_level('debug');
  43             } elsif ($opt eq 'verbose') {
  44               $self->{logger}->more_verbose();
  45             } elsif ($opt eq 'no-check-cert') {
  46               $self->{logger}->log('error', "Received no-check-cert option.  Why are you bothering with hkpms if you aren't checking?\n");
  47               $self->{actually_check} = 0;
  48             } elsif ($opt eq 'check-cert') {
  49               $self->{actually_check} = 1;
  50             } elsif ($opt =~ /^http-proxy=(.*)/) {
  51               my $hp = $1;
  52               if ($hp =~ /^(socks|http|https):\/\/($RE{net}{domain}|$RE{net}{IPv4}):([[:digit:]]+)\/?$/) {
  53                 if ('socks' eq $1) {
  54                   if ( ! Module::Load::Conditional::check_install(module => 'LWP::Protocol::socks')) {
  55                     $self->{logger}->log('error', "Requesting a socks proxy for hkpms, but LWP::Protocol::socks is not installed.\nThis will likely fail.\n");
  56                   }
  57                 }
  58                 $self->{proxy} = sprintf('%s://%s:%s', $1, $2, $3);
  59               } else {
  60                 $self->{logger}->log('error', "Failed to make sense of this http-proxy address: '%s'; ignoring.\n", $hp);
  61               }
  62             } else {
  63               $self->{logger}->log('error', "Received '%s' as an option, but gpgkeys_hkpms does not implement it. Ignoring...\n", $opt);
  64             }
  65             # FIXME: consider other keyserver-options from gpg(1).
  66             # in particular, the following might be interesting:
  67             # timeout
  68             # include-revoked
  69             # include-disabled
  70             # ca-cert-file
  71           }
  72         }
  73       } else {
  74         push(@{$self->{args}}, $line);
  75       }
  76     }
  77   }
  78
  79   sub verify_cert {
  80     my $self = shift;
  81     my ($ok, $ctxstore, $certname, $error, $cert) = @_;
  82     my $certpem = Net::SSLeay::PEM_get_string_X509($cert);
  83     my ($status, $ret);
  84
  85     if (exists $self->{cache}->{$certpem}) {
  86       ($status, $ret) = @{$self->{cache}->{$certpem}};
  87       $self->{logger}->log('debug', "Found response in cache\n");
  88     } else {
  89       # use Crypt::Monkeysphere::MSVA::Client if available:
  90       if (defined($self->{client})) {
  91         # because we really don't want to create some sort of MSVA loop:
  92         ($status, $ret) = $self->{client}->query_agent('https', $self->{config}->{host}, 'server', 'x509pem', $certpem, 'never');
  93       } else {
  94         use Crypt::Monkeysphere::MSVA;
  95         $self->{logger}->log('verbose', "Could not find a running agent (MONKEYSPHERE_VALIDATION_AGENT_SOCKET env var).\nFalling back to in-process certificate checks.\n");
  96         # If there is no running agent, we might want to be able to fall
  97         # back here.
  98
  99         # FIXME: this is hackery!  we're just calling daemon-internal code
 100         # (and it's not a stable API):
 101
 102         my $data = {peer => { name => $self->{config}->{host}, type => 'server' },
 103                     context => 'https',
 104                     pkc => { type => 'x509pem', data => $certpem },
 105                     keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop
 106                    };
 107
 108         my $clientinfo = { uid => POSIX::geteuid(), inode => undef };
 109
 110         ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo);
 111       }
 112
 113       # make a cache of the cert if it verifies once, since this seems
 114       # to get called 3 times by perl for some reason. (see
 115       # https://bugs.debian.org/606249)
 116       $self->{cache}->{$certpem} = [ $status, $ret ];
 117       if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
 118         $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n  %s\n", $ret->{message});
 119       } else {
 120         $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n  %s\n", $ret->{message});
 121       }
 122     }
 123
 124     if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
 125       return 1;
 126     } else {
 127       return 0;
 128     }
 129   }
 130
 131   sub query {
 132     my $self = shift;
 133
 134     # FIXME: i'd like to pass this debug argument to IO::Socket::SSL,
 135     # but i don't know how to do that.
 136     # i get 'Variable "@iosslargs" will not stay shared' if i try to call
 137     # use IO::Socket::SSL 1.37 @iosslargs;
 138     my @iosslargs = ();
 139     if ($self->{logger}->get_log_level() >= 4) {
 140       push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3));
 141     }
 142
 143     # versions earlier than 1.35 can fail open: bad news!.
 144     # 1.37 lets us set ca_path and ca_file to undef, which is what we want.
 145     use IO::Socket::SSL 1.37;
 146     use Net::SSLeay;
 147     use LWP::UserAgent;
 148     use URI;
 149
 150     IO::Socket::SSL::set_ctx_defaults(
 151                                       verify_callback => sub { $self->verify_cert(@_); },
 152                                       verify_mode => 0x03,
 153                                       ca_path => undef,
 154                                       ca_file => undef,
 155                                      );
 156
 157     my $ua = LWP::UserAgent::->new();
 158
 159     if (exists($self->{proxy})) {
 160       $self->{logger}->log('verbose', "Using http-proxy: %s\n", $self->{proxy});
 161       $ua->proxy([qw(http https)] => $self->{proxy});
 162     } else {
 163       # if no proxy was explicitly set, use the environment:
 164       $ua->env_proxy();
 165     }
 166
 167     printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n",
 168            $self->{config}->{program},  # this is kind of cheating :/
 169            $Crypt::Monkeysphere::MSVA::VERSION);
 170
 171
 172     $self->{logger}->log('debug', "command: %s\n", $self->{config}->{command});
 173     if (lc($self->{config}->{command}) eq 'search') {
 174       # for COMMAND = SEARCH, we want op=index, and we want to rejoin all args with spaces.
 175       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
 176       my $arg = join(' ', @{$self->{args}});
 177       $uri->query_form(op => 'index',
 178                        options => 'mr',
 179                        search => $arg,
 180                       );
 181       $arg =~ s/\n/ /g ; # swap out newlines for spaces
 182       printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
 183       $self->{logger}->log('debug', "URI: %s\n", $uri);
 184       my $resp = $ua->get($uri);
 185       if ($resp->is_success) {
 186         print($resp->decoded_content);
 187       } else {
 188         # FIXME: handle errors better
 189         $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 190       }
 191       printf("\n%s %s END\n", $self->{config}->{command}, $arg);
 192     } elsif (lc($self->{config}->{command}) eq 'get') {
 193       # for COMMAND = GET, we want op=get, and we want to issue each query separately.
 194       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
 195       foreach my $arg (@{$self->{args}}) {
 196         printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
 197         $uri->query_form(op => 'get',
 198                          options => 'mr',
 199                          search => $arg,
 200                         );
 201         my $resp = $ua->get($uri);
 202         if ($resp->is_success) {
 203           print($resp->decoded_content);
 204         } else {
 205           # FIXME: handle errors better
 206           $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 207         }
 208         printf("\n%s %s END\n", $self->{config}->{command}, $arg);
 209       }
 210     } elsif (lc($self->{config}->{command}) eq 'send') {
 211       $self->{logger}->log('debug', "Sending keys");
 212       # walk the input looking for "KEY E403BC1A17856FB7 BEGIN" lines.
 213       my @keydata;
 214       my $keyid;
 215       foreach my $arg (@{$self->{args}}) {
 216         if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) {
 217           @keydata = ();
 218           $keyid = $1;
 219           $self->{logger}->log('debug', "Found KEY BEGIN line (%s)\n", $keyid);
 220         } elsif (defined($keyid)) {
 221           if ($arg eq sprintf('KEY %s END', $keyid)) {
 222             $self->{logger}->log('debug', "Found KEY END line with %d lines of data elapsed\n", scalar(@keydata));
 223             # for sending keys, we want to POST to /pks/add, with a keytext variable.
 224             my $uri = URI::->new(sprintf('https://%s/pks/add', $self->{config}->{host}));
 225             my $resp = $ua->post($uri, {keytext => join("\n", @keydata)});
 226             if ($resp->is_success) {
 227               printf("\n%s", $resp->decoded_content);
 228             } else {
 229               # FIXME: handle errors better
 230               $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 231             }
 232             printf("\nKEY %s SENT\n", $keyid);
 233             @keydata = ();
 234             $keyid = undef;
 235           } else {
 236             push @keydata, $arg;
 237           }
 238         } else {
 239           $self->{logger}->log('debug2', "Found garbage line\n");
 240         }
 241       }
 242       if (defined($keyid)) {
 243         $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid);
 244       }
 245     } else {
 246       # are there other commands we might want?
 247       $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command});
 248     }
 249   }
 250
 251
 252   sub new {
 253     my $class = shift;
 254
 255     my $default_log_level = 'error';
 256     my $client;
 257     if (exists($ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET})) {
 258       $client = Crypt::Monkeysphere::MSVA::Client::->new(
 259                                                          socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET},
 260                                                          log_level => $default_log_level,
 261                                                         );
 262     }
 263     my $self = { config => { },
 264                  args => [ ],
 265                  logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::Logger::->new($default_log_level)),
 266                  cache => { },
 267                  client => $client,
 268                  actually_check => 1,
 269                };
 270
 271     bless ($self, $class);
 272     return $self;
 273   }
 274   1;
 275 }
 276
 277
 278 my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new();
 279
 280 my $input = # load gpg instructions from stdin:
 281   do {
 282     local $/; # slurp!
 283     <STDIN>;
 284   };
 285
 286
 287 $hkpms->parse_input($input);
 288 $hkpms->query();
 289