From: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
Date: Wed, 8 Dec 2010 02:37:24 +0000 (-0500)
Subject: supply gpgkeys_hkpms (closes MS #2016)
X-Git-Tag: msva-perl_debian/0.7-1~5^2
X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=2963a8495b88ce3886686c9c0b5b522bf731ce10;p=monkeysphere-validation-agent.git

supply gpgkeys_hkpms (closes MS #2016)
---

diff --git a/Changelog b/Changelog
index 21de2b2..e2d9ee6 100644
--- a/Changelog
+++ b/Changelog
@@ -1,8 +1,10 @@
 msva-perl (0.7~pre) unstable; urgency=low
 
   * udpated msva-query-agent documentation
+  * added gpgkeys_hkpms for monkeysphere-authenticated HKPS access
+    (closes MS #2016)
 
- -- Daniel Kahn Gillmor <dkg@fifthhorseman.net>  Sun, 14 Nov 2010 18:51:18 -0500
+ -- Daniel Kahn Gillmor <dkg@fifthhorseman.net>  Tue, 07 Dec 2010 21:34:23 -0500
 
 msva-perl (0.6) upstream;
 
diff --git a/Crypt/Monkeysphere/MSVA.pm b/Crypt/Monkeysphere/MSVA.pm
index 53df4b5..16e495c 100755
--- a/Crypt/Monkeysphere/MSVA.pm
+++ b/Crypt/Monkeysphere/MSVA.pm
@@ -41,7 +41,7 @@
   # we need the version of GnuPG::Interface that knows about pubkey_data, etc:
   use GnuPG::Interface 0.42.02;
 
-  $VERSION = '0.6';
+  $VERSION = '0.7';
 
   my $gnupg = GnuPG::Interface->new();
   $gnupg->options->quiet(1);
diff --git a/gpgkeys_hkpms b/gpgkeys_hkpms
new file mode 100755
index 0000000..74abf9a
--- /dev/null
+++ b/gpgkeys_hkpms
@@ -0,0 +1,234 @@
+#!/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();
+