From: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
Date: Thu, 16 Dec 2010 16:09:48 +0000 (-0500)
Subject: adopt new 1.37 changes to IO::Socket::SSL
X-Git-Tag: msva-perl_debian/0.7-1~3^2~4
X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=2a3909319606d53171273714e430aa374405c602;p=monkeysphere-validation-agent.git

adopt new 1.37 changes to IO::Socket::SSL
---

diff --git a/gpgkeys_hkpms b/gpgkeys_hkpms
index 74abf9a..4c18fbf 100755
--- a/gpgkeys_hkpms
+++ b/gpgkeys_hkpms
@@ -34,6 +34,16 @@ use warnings;
           my @args = split(/ /, $line);
           my $cmd = shift @args;
           $self->{config}->{lc($cmd)} = join(' ', @args);
+          # FIXME: consider other keyserver-options from gpg(1).
+          # in particular, the following might be interesting:
+          # debug
+          # verbose
+          # timeout
+          # check-cert
+          # include-revoked
+          # include-disabled
+          # ca-cert-file
+          # http-proxy
         }
       } else {
         push(@{$self->{args}}, $line);
@@ -49,7 +59,7 @@ use warnings;
 
     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})) {
@@ -78,11 +88,18 @@ use warnings;
       # 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 {
@@ -91,14 +108,15 @@ use warnings;
     # 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;
@@ -106,8 +124,8 @@ use warnings;
     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();