use POSIX;
use Crypt::Monkeysphere::MSVA::Logger;
use Crypt::Monkeysphere::MSVA::Client;
+ use Regexp::Common qw /net/;
+ use Module::Load::Conditional;
sub parse_input {
my $self = shift;
my @args = split(/ /, $line);
my $cmd = shift @args;
$self->{config}->{lc($cmd)} = join(' ', @args);
+ if (lc($cmd) eq 'option') {
+ my $opt = lc($args[0]);
+ if ($opt eq 'debug') {
+ $self->{logger}->set_log_level('debug');
+ } elsif ($opt eq 'verbose') {
+ $self->{logger}->more_verbose();
+ } elsif ($opt eq 'no-check-cert') {
+ $self->{logger}->log('error', "Received no-check-cert option. Why are you bothering with hkpms if you aren't checking?\n");
+ $self->{actually_check} = 0;
+ } elsif ($opt eq 'check-cert') {
+ $self->{actually_check} = 1;
+ } elsif ($opt =~ /^http-proxy=(.*)/) {
+ my $hp = $1;
+ if ($hp =~ /^(socks|http|https):\/\/($RE{net}{domain}|$RE{net}{IPv4}):([[:digit:]]+)\/?$/) {
+ if ('socks' eq $1) {
+ if ( ! Module::Load::Conditional::check_install(module => 'LWP::Protocol::socks')) {
+ $self->{logger}->log('error', "Requesting a socks proxy for hkpms, but LWP::Protocol::socks is not installed.\nThis will likely fail.\n");
+ }
+ }
+ $self->{proxy} = sprintf('%s://%s:%s', $1, $2, $3);
+ } else {
+ $self->{logger}->log('error', "Failed to make sense of this http-proxy address: '%s'; ignoring.\n", $hp);
+ }
+ } else {
+ $self->{logger}->log('error', "Received '%s' as an option, but gpgkeys_hkpms does not implement it. Ignoring...\n", $opt);
+ }
+ # FIXME: consider other keyserver-options from gpg(1).
+ # in particular, the following might be interesting:
+ # timeout
+ # include-revoked
+ # include-disabled
+ # ca-cert-file
+ }
}
} else {
push(@{$self->{args}}, $line);
if (exists $self->{cache}->{$certpem}) {
($status, $ret) = @{$self->{cache}->{$certpem}};
- $self->{logger}->log('verbose', "Found response in cache\n");
+ $self->{logger}->log('debug', "Found response in cache\n");
} else {
# use Crypt::Monkeysphere::MSVA::Client if available:
if (defined($self->{client})) {
($status, $ret) = $self->{client}->query_agent('https', $self->{config}->{host}, 'server', 'x509pem', $certpem, 'never');
} else {
use Crypt::Monkeysphere::MSVA;
+ $self->{logger}->log('verbose', "Could not find a running agent (MONKEYSPHERE_VALIDATION_AGENT_SOCKET env var).\nFalling back to in-process certificate checks.\n");
# If there is no running agent, we might want to be able to fall
# back here.
# to get called 3 times by perl for some reason. (see
# https://bugs.debian.org/606249)
$self->{cache}->{$certpem} = [ $status, $ret ];
- $self->{logger}->log('info', "%s\n", $ret->{message})
- if defined $ret->{message};
+ if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
+ $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n %s\n", $ret->{message});
+ } else {
+ $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n %s\n", $ret->{message});
+ }
}
- return (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1));
+ if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
+ return 1;
+ } else {
+ return 0;
+ }
}
sub query {
# FIXME: i'd like to pass this debug argument to IO::Socket::SSL,
# but i don't know how to do that.
# i get 'Variable "@iosslargs" will not stay shared' if i try to call
- # use IO::Socket::SSL 1.35 @iosslargs;
+ # use IO::Socket::SSL 1.37 @iosslargs;
my @iosslargs = ();
if ($self->{logger}->get_log_level() >= 4) {
push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3));
}
- # earlier versions can fail open, defeating the purpose here.
- use IO::Socket::SSL 1.35;
+ # versions earlier than 1.35 can fail open: bad news!.
+ # 1.37 lets us set ca_path and ca_file to undef, which is what we want.
+ use IO::Socket::SSL 1.37;
use Net::SSLeay;
use LWP::UserAgent;
use URI;
IO::Socket::SSL::set_ctx_defaults(
verify_callback => sub { $self->verify_cert(@_); },
verify_mode => 0x03,
- # this parameter is foolish: http://bugs.debian.org/606243
- ca_path => '.',
+ ca_path => undef,
+ ca_file => undef,
);
- my $ua = LWP::UserAgent->new();
+ my $ua = LWP::UserAgent::->new();
+
+ if (exists($self->{proxy})) {
+ $self->{logger}->log('verbose', "Using http-proxy: %s\n", $self->{proxy});
+ $ua->proxy([qw(http https)] => $self->{proxy});
+ } else {
+ # if no proxy was explicitly set, use the environment:
+ $ua->env_proxy();
+ }
printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n",
$self->{config}->{program}, # this is kind of cheating :/
$self->{logger}->log('debug', "command: %s\n", $self->{config}->{command});
if (lc($self->{config}->{command}) eq 'search') {
# for COMMAND = SEARCH, we want op=index, and we want to rejoin all args with spaces.
- my $uri = new URI(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
+ my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
my $arg = join(' ', @{$self->{args}});
$uri->query_form(op => 'index',
options => 'mr',
);
$arg =~ s/\n/ /g ; # swap out newlines for spaces
printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
+ $self->{logger}->log('debug', "URI: %s\n", $uri);
my $resp = $ua->get($uri);
if ($resp->is_success) {
print($resp->decoded_content);
printf("\n%s %s END\n", $self->{config}->{command}, $arg);
} elsif (lc($self->{config}->{command}) eq 'get') {
# for COMMAND = GET, we want op=get, and we want to issue each query separately.
- my $uri = new URI(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
+ my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
foreach my $arg (@{$self->{args}}) {
printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
$uri->query_form(op => 'get',
if ($arg eq sprintf('KEY %s END', $keyid)) {
$self->{logger}->log('debug', "Found KEY END line with %d lines of data elapsed\n", scalar(@keydata));
# for sending keys, we want to POST to /pks/add, with a keytext variable.
- my $uri = new URI(sprintf('https://%s/pks/add', $self->{config}->{host}));
+ my $uri = URI::->new(sprintf('https://%s/pks/add', $self->{config}->{host}));
my $resp = $ua->post($uri, {keytext => join("\n", @keydata)});
if ($resp->is_success) {
printf("\n%s", $resp->decoded_content);
sub new {
my $class = shift;
+ my $default_log_level = 'error';
my $client;
if (exists($ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET})) {
- $client = Crypt::Monkeysphere::MSVA::Client->new(
- socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET},
- log_level => $ENV{MSVA_LOG_LEVEL},
- );
+ $client = Crypt::Monkeysphere::MSVA::Client::->new(
+ socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET},
+ log_level => $default_log_level,
+ );
}
my $self = { config => { },
args => [ ],
- logger => Crypt::Monkeysphere::MSVA::Logger->new($ENV{MSVA_LOG_LEVEL}),
+ logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::MSVA::Logger::->new($default_log_level)),
cache => { },
client => $client,
+ actually_check => 1,
};
bless ($self, $class);
}
-my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS->new();
+my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new();
my $input = # load gpg instructions from stdin:
do {
projects / monkeysphere-validation-agent.git / blobdiff