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::MSVA::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         # If there is no running agent, we might want to be able to fall
  96         # back here.
  97
  98         # FIXME: this is hackery!  we're just calling daemon-internal code
  99         # (and it's not a stable API):
 100
 101         my $data = {peer => { name => $self->{config}->{host}, type => 'server' },
 102                     context => 'https',
 103                     pkc => { type => 'x509pem', data => $certpem },
 104                     keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop
 105                    };
 106
 107         my $clientinfo = { uid => POSIX::geteuid(), inode => undef };
 108
 109         ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo);
 110       }
 111
 112       # make a cache of the cert if it verifies once, since this seems
 113       # to get called 3 times by perl for some reason. (see
 114       # https://bugs.debian.org/606249)
 115       $self->{cache}->{$certpem} = [ $status, $ret ];
 116       if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
 117         $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n  %s\n", $ret->{message});
 118       } else {
 119         $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n  %s\n", $ret->{message});
 120       }
 121     }
 122
 123     if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
 124       return 1;
 125     } else {
 126       return 0;
 127     }
 128   }
 129
 130   sub query {
 131     my $self = shift;
 132
 133     # FIXME: i'd like to pass this debug argument to IO::Socket::SSL,
 134     # but i don't know how to do that.
 135     # i get 'Variable "@iosslargs" will not stay shared' if i try to call
 136     # use IO::Socket::SSL 1.37 @iosslargs;
 137     my @iosslargs = ();
 138     if ($self->{logger}->get_log_level() >= 4) {
 139       push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3));
 140     }
 141
 142     # versions earlier than 1.35 can fail open: bad news!.
 143     # 1.37 lets us set ca_path and ca_file to undef, which is what we want.
 144     use IO::Socket::SSL 1.37;
 145     use Net::SSLeay;
 146     use LWP::UserAgent;
 147     use URI;
 148
 149     IO::Socket::SSL::set_ctx_defaults(
 150                                       verify_callback => sub { $self->verify_cert(@_); },
 151                                       verify_mode => 0x03,
 152                                       ca_path => undef,
 153                                       ca_file => undef,
 154                                      );
 155
 156     my $ua = LWP::UserAgent::->new();
 157
 158     if (exists($self->{proxy})) {
 159       $self->{logger}->log('verbose', "Using http-proxy: %s\n", $self->{proxy});
 160       $ua->proxy([qw(http https)] => $self->{proxy});
 161     } else {
 162       # if no proxy was explicitly set, use the environment:
 163       $ua->env_proxy();
 164     }
 165
 166     printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n",
 167            $self->{config}->{program},  # this is kind of cheating :/
 168            $Crypt::Monkeysphere::MSVA::VERSION);
 169
 170
 171     $self->{logger}->log('debug', "command: %s\n", $self->{config}->{command});
 172     if (lc($self->{config}->{command}) eq 'search') {
 173       # for COMMAND = SEARCH, we want op=index, and we want to rejoin all args with spaces.
 174       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
 175       my $arg = join(' ', @{$self->{args}});
 176       $uri->query_form(op => 'index',
 177                        options => 'mr',
 178                        search => $arg,
 179                       );
 180       $arg =~ s/\n/ /g ; # swap out newlines for spaces
 181       printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
 182       $self->{logger}->log('debug', "URI: %s\n", $uri);
 183       my $resp = $ua->get($uri);
 184       if ($resp->is_success) {
 185         print($resp->decoded_content);
 186       } else {
 187         # FIXME: handle errors better
 188         $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 189       }
 190       printf("\n%s %s END\n", $self->{config}->{command}, $arg);
 191     } elsif (lc($self->{config}->{command}) eq 'get') {
 192       # for COMMAND = GET, we want op=get, and we want to issue each query separately.
 193       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
 194       foreach my $arg (@{$self->{args}}) {
 195         printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
 196         $uri->query_form(op => 'get',
 197                          options => 'mr',
 198                          search => $arg,
 199                         );
 200         my $resp = $ua->get($uri);
 201         if ($resp->is_success) {
 202           print($resp->decoded_content);
 203         } else {
 204           # FIXME: handle errors better
 205           $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 206         }
 207         printf("\n%s %s END\n", $self->{config}->{command}, $arg);
 208       }
 209     } elsif (lc($self->{config}->{command}) eq 'send') {
 210       $self->{logger}->log('debug', "Sending keys");
 211       # walk the input looking for "KEY E403BC1A17856FB7 BEGIN" lines.
 212       my @keydata;
 213       my $keyid;
 214       foreach my $arg (@{$self->{args}}) {
 215         if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) {
 216           @keydata = ();
 217           $keyid = $1;
 218           $self->{logger}->log('debug', "Found KEY BEGIN line (%s)\n", $keyid);
 219         } elsif (defined($keyid)) {
 220           if ($arg eq sprintf('KEY %s END', $keyid)) {
 221             $self->{logger}->log('debug', "Found KEY END line with %d lines of data elapsed\n", scalar(@keydata));
 222             # for sending keys, we want to POST to /pks/add, with a keytext variable.
 223             my $uri = URI::->new(sprintf('https://%s/pks/add', $self->{config}->{host}));
 224             my $resp = $ua->post($uri, {keytext => join("\n", @keydata)});
 225             if ($resp->is_success) {
 226               printf("\n%s", $resp->decoded_content);
 227             } else {
 228               # FIXME: handle errors better
 229               $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
 230             }
 231             printf("\nKEY %s SENT\n", $keyid);
 232             @keydata = ();
 233             $keyid = undef;
 234           } else {
 235             push @keydata, $arg;
 236           }
 237         } else {
 238           $self->{logger}->log('debug2', "Found garbage line\n");
 239         }
 240       }
 241       if (defined($keyid)) {
 242         $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid);
 243       }
 244     } else {
 245       # are there other commands we might want?
 246       $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command});
 247     }
 248   }
 249
 250
 251   sub new {
 252     my $class = shift;
 253
 254     my $default_log_level = 'error';
 255     my $client;
 256     if (exists($ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET})) {
 257       $client = Crypt::Monkeysphere::MSVA::Client::->new(
 258                                                          socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET},
 259                                                          log_level => $default_log_level,
 260                                                         );
 261     }
 262     my $self = { config => { },
 263                  args => [ ],
 264                  logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::MSVA::Logger::->new($default_log_level)),
 265                  cache => { },
 266                  client => $client,
 267                  actually_check => 1,
 268                };
 269
 270     bless ($self, $class);
 271     return $self;
 272   }
 273   1;
 274 }
 275
 276
 277 my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new();
 278
 279 my $input = # load gpg instructions from stdin:
 280   do {
 281     local $/; # slurp!
 282     <STDIN>;
 283   };
 284
 285
 286 $hkpms->parse_input($input);
 287 $hkpms->query();
 288