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