3 # hkpms transport -- HKP-over-TLS, authenticated by monkeysphere
10 # Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
13 # (you should have received a COPYING file with this distribution)
18 { package Crypt::Monkeysphere::MSVA::HKPMS;
20 use Crypt::Monkeysphere::Logger;
21 use Crypt::Monkeysphere::MSVA::Client;
22 use Regexp::Common qw /net/;
23 use Module::Load::Conditional;
30 foreach my $line (split(/\n/, $input)) {
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=(.*)/) {
52 if ($hp =~ /^(socks|http|https):\/\/($RE{net}{domain}|$RE{net}{IPv4}):([[:digit:]]+)\/?$/) {
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");
58 $self->{proxy} = sprintf('%s://%s:%s', $1, $2, $3);
60 $self->{logger}->log('error', "Failed to make sense of this http-proxy address: '%s'; ignoring.\n", $hp);
63 $self->{logger}->log('error', "Received '%s' as an option, but gpgkeys_hkpms does not implement it. Ignoring...\n", $opt);
65 # FIXME: consider other keyserver-options from gpg(1).
66 # in particular, the following might be interesting:
74 push(@{$self->{args}}, $line);
81 my ($ok, $ctxstore, $certname, $error, $cert) = @_;
82 my $certpem = Net::SSLeay::PEM_get_string_X509($cert);
85 if (exists $self->{cache}->{$certpem}) {
86 ($status, $ret) = @{$self->{cache}->{$certpem}};
87 $self->{logger}->log('debug', "Found response in cache\n");
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');
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
99 # FIXME: this is hackery! we're just calling daemon-internal code
100 # (and it's not a stable API):
102 my $data = {peer => { name => $self->{config}->{host}, type => 'server' },
104 pkc => { type => 'x509pem', data => $certpem },
105 keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop
108 my $clientinfo = { uid => POSIX::geteuid(), inode => undef };
110 ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo);
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});
120 $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n %s\n", $ret->{message});
124 if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
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;
139 if ($self->{logger}->get_log_level() >= 4) {
140 push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3));
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;
150 IO::Socket::SSL::set_ctx_defaults(
151 verify_callback => sub { $self->verify_cert(@_); },
157 my $ua = LWP::UserAgent::->new();
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});
163 # if no proxy was explicitly set, use the environment:
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);
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',
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);
188 # FIXME: handle errors better
189 $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
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',
201 my $resp = $ua->get($uri);
202 if ($resp->is_success) {
203 print($resp->decoded_content);
205 # FIXME: handle errors better
206 $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
208 printf("\n%s %s END\n", $self->{config}->{command}, $arg);
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.
215 foreach my $arg (@{$self->{args}}) {
216 if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) {
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);
229 # FIXME: handle errors better
230 $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
232 printf("\nKEY %s SENT\n", $keyid);
239 $self->{logger}->log('debug2', "Found garbage line\n");
242 if (defined($keyid)) {
243 $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid);
246 # are there other commands we might want?
247 $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command});
255 my $default_log_level = 'error';
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,
263 my $self = { config => { },
265 logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::Logger::->new($default_log_level)),
271 bless ($self, $class);
278 my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new();
280 my $input = # load gpg instructions from stdin:
287 $hkpms->parse_input($input);