--- /dev/null
+#!/usr/bin/perl -w
+
+# hkpms transport -- HKP-over-TLS, authenticated by monkeysphere
+
+use strict;
+use warnings;
+
+
+
+# Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+# Copyright: 2010
+# License: GPL v3+
+# (you should have received a COPYING file with this distribution)
+
+
+
+
+{ package Crypt::Monkeysphere::MSVA::HKPMS;
+ use POSIX;
+ use Crypt::Monkeysphere::MSVA::Logger;
+ use Crypt::Monkeysphere::MSVA::Client;
+
+ sub parse_input {
+ my $self = shift;
+ my $input = shift;
+
+ my $inheaders = 1;
+ foreach my $line (split(/\n/, $input)) {
+ if ($inheaders) {
+ if ($line eq '') {
+ $inheaders = 0;
+ } else {
+ next if ($line =~ /^#/);
+ my @args = split(/ /, $line);
+ my $cmd = shift @args;
+ $self->{config}->{lc($cmd)} = join(' ', @args);
+ }
+ } else {
+ push(@{$self->{args}}, $line);
+ }
+ }
+ }
+
+ sub verify_cert {
+ my $self = shift;
+ my ($ok, $ctxstore, $certname, $error, $cert) = @_;
+ my $certpem = Net::SSLeay::PEM_get_string_X509($cert);
+ my ($status, $ret);
+
+ if (exists $self->{cache}->{$certpem}) {
+ ($status, $ret) = @{$self->{cache}->{$certpem}};
+ $self->{logger}->log('verbose', "Found response in cache\n");
+ } else {
+ # use Crypt::Monkeysphere::MSVA::Client if available:
+ if (defined($self->{client})) {
+ # because we really don't want to create some sort of MSVA loop:
+ ($status, $ret) = $self->{client}->query_agent('https', $self->{config}->{host}, 'server', 'x509pem', $certpem, 'never');
+ } else {
+ use Crypt::Monkeysphere::MSVA;
+ # If there is no running agent, we might want to be able to fall
+ # back here.
+
+ # FIXME: this is hackery! we're just calling daemon-internal code
+ # (and it's not a stable API):
+
+ my $data = {peer => { name => $self->{config}->{host}, type => 'server' },
+ context => 'https',
+ pkc => { type => 'x509pem', data => $certpem },
+ keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop
+ };
+
+ my $clientinfo = { uid => POSIX::geteuid(), inode => undef };
+
+ ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo);
+ }
+
+ # make a cache of the cert if it verifies once, since this seems
+ # 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};
+ }
+
+ return (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1));
+ }
+
+ sub query {
+ my $self = shift;
+
+ # 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;
+ 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;
+ 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 => '.',
+ );
+
+ my $ua = LWP::UserAgent->new();
+
+ printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n",
+ $self->{config}->{program}, # this is kind of cheating :/
+ $Crypt::Monkeysphere::MSVA::VERSION);
+
+
+ $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 $arg = join(' ', @{$self->{args}});
+ $uri->query_form(op => 'index',
+ options => 'mr',
+ search => $arg,
+ );
+ $arg =~ s/\n/ /g ; # swap out newlines for spaces
+ printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
+ my $resp = $ua->get($uri);
+ if ($resp->is_success) {
+ print($resp->decoded_content);
+ } else {
+ # FIXME: handle errors better
+ $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
+ }
+ 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}));
+ foreach my $arg (@{$self->{args}}) {
+ printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
+ $uri->query_form(op => 'get',
+ options => 'mr',
+ search => $arg,
+ );
+ my $resp = $ua->get($uri);
+ if ($resp->is_success) {
+ print($resp->decoded_content);
+ } else {
+ # FIXME: handle errors better
+ $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
+ }
+ printf("\n%s %s END\n", $self->{config}->{command}, $arg);
+ }
+ } elsif (lc($self->{config}->{command}) eq 'send') {
+ $self->{logger}->log('debug', "Sending keys");
+ # walk the input looking for "KEY E403BC1A17856FB7 BEGIN" lines.
+ my @keydata;
+ my $keyid;
+ foreach my $arg (@{$self->{args}}) {
+ if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) {
+ @keydata = ();
+ $keyid = $1;
+ $self->{logger}->log('debug', "Found KEY BEGIN line (%s)\n", $keyid);
+ } elsif (defined($keyid)) {
+ 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 $resp = $ua->post($uri, {keytext => join("\n", @keydata)});
+ if ($resp->is_success) {
+ printf("\n%s", $resp->decoded_content);
+ } else {
+ # FIXME: handle errors better
+ $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
+ }
+ printf("\nKEY %s SENT\n", $keyid);
+ @keydata = ();
+ $keyid = undef;
+ } else {
+ push @keydata, $arg;
+ }
+ } else {
+ $self->{logger}->log('debug2', "Found garbage line\n");
+ }
+ }
+ if (defined($keyid)) {
+ $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid);
+ }
+ } else {
+ # are there other commands we might want?
+ $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command});
+ }
+ }
+
+
+ sub new {
+ my $class = shift;
+
+ 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},
+ );
+ }
+ my $self = { config => { },
+ args => [ ],
+ logger => Crypt::Monkeysphere::MSVA::Logger->new($ENV{MSVA_LOG_LEVEL}),
+ cache => { },
+ client => $client,
+ };
+
+ bless ($self, $class);
+ return $self;
+ }
+ 1;
+}
+
+
+my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS->new();
+
+my $input = # load gpg instructions from stdin:
+ do {
+ local $/; # slurp!
+ <STDIN>;
+ };
+
+
+$hkpms->parse_input($input);
+$hkpms->query();
+
projects / monkeysphere-validation-agent.git / commitdiff