added peertype (addresses #2568) -- still need tests

diff --git a/Crypt/Monkeysphere/MSVA.pm b/Crypt/Monkeysphere/MSVA.pm
index ca887733bd42fcdc9a3f26b3c9fa054b208a8579..507bafe5a6b52fb56ce6156a1b016e3f5a3ec321 100755 (executable)
--- a/Crypt/Monkeysphere/MSVA.pm
+++ b/Crypt/Monkeysphere/MSVA.pm
@@ -582,27 +582,50 @@
                };
 
     # check context string
-    if ($data->{context} =~ /^(https|ssh|smtp|ike)$/) {
+    if ($data->{context} =~ /^(https|ssh|smtp|ike|postgresql|imaps|imap|submission)$/) {
        $data->{context} = $1;
     } else {
        msvalog('error', "invalid context: %s\n", $data->{context});
-       $ret->{message} = sprintf("Invalid context: %s", $data->{context});
+       $ret->{message} = sprintf("Invalid/unknown context: %s", $data->{context});
        return $status,$ret;
     }
     msvalog('verbose', "context: %s\n", $data->{context});
 
     # checkout peer string
-    if ($data->{peer} =~ /^($RE{net}{domain})$/) {
-       $data->{peer} = $1;
+    # old-style just passed a string as a peer, rather than 
+    # peer: { name: 'whatever', 'type': 'client' }
+    $data->{peer} = { name => $data->{peer} }
+      if (ref($data->{peer}) ne 'HASH');
+
+    if ($data->{peer}->{name} =~ /^($RE{net}{domain})$/) {
+       $data->{peer}->{name} = $1;
     } else {
-       msvalog('error', "invalid peer string: %s\n", $data->{peer});
-       $ret->{message} = sprintf("Invalid peer string: %s", $data->{peer});
+       msvalog('error', "invalid peer name string: %s\n", $data->{peer}->{name});
+       $ret->{message} = sprintf("Invalid peer name string: %s", $data->{peer}->{name});
        return $status,$ret;
     }
-    msvalog('verbose', "peer: %s\n", $data->{peer});
+    if (defined($data->{peer}->{type})) {
+      if ($data->{peer}->{type} =~ /^(client|server|peer)$/) {
+        $data->{peer}->{type} = $1;
+      } else {
+       msvalog('error', "invalid peer type string: %s\n", $data->{peer}->{type});
+       $ret->{message} = sprintf("Invalid peer type string: %s", $data->{peer}->{type});
+       return $status,$ret;
+      }
+    }
+
+    msvalog('verbose', "peer: %s\n", $data->{peer}->{name});
 
     # generate uid string
-    my $uid = $data->{context}.'://'.$data->{peer};
+    my $prefix = $data->{context}.'://';
+    if (defined $data->{peer}->{type} &&
+        $data->{peer}->{type} eq 'client' &&
+        # ike and smtp clients are effectively other servers, so we'll
+        # exclude them:
+        $data->{context} !~ /^(ike|smtp)$/) {
+      $prefix = '';
+    }
+    my $uid = $prefix.$data->{peer}->{name};
     msvalog('verbose', "user ID: %s\n", $uid);
 
     # check pkc type

diff --git a/Crypt/Monkeysphere/MSVA/Client.pm b/Crypt/Monkeysphere/MSVA/Client.pm
index 9b3991d26d0a4283fcbe176e9c8486e663c07d57..ad1cb5db1c631ad51b63e4e88cc0c8d2a285c69e 100644 (file)
--- a/Crypt/Monkeysphere/MSVA/Client.pm
+++ b/Crypt/Monkeysphere/MSVA/Client.pm
@@ -40,10 +40,11 @@
     my $self = shift;
     my $context = shift;
     my $peer = shift;
+    my $peertype = shift;
     my $pkctype = shift;
     my $pkcdata = shift;
 
-    my $apd = $self->create_apd($context, $peer, $pkctype, $pkcdata);
+    my $apd = $self->create_apd($context, $peer, $peertype, $pkctype, $pkcdata);
 
     my $apdjson = to_json($apd);
 
@@ -79,6 +80,7 @@
     my $self = shift;
     my $context = shift;
     my $peer = shift;
+    my $peertype = shift;
     my $pkctype = shift;
     my $pkcdata = shift;
 
@@ -117,14 +119,18 @@
       $self->log('error', "unknown pkc type '%s'.\n", $pkctype);
     };
 
-    return {
-            context => $context,
-            peer => $peer,
-            pkc => {
-                    type => $pkctype,
-                    data => $transformed_data,
-                   },
-           };
+    my $ret = {
+               context => $context,
+               peer => { name => $peer},
+               pkc => {
+                       type => $pkctype,
+                       data => $transformed_data,
+                      },
+              };
+    $ret->{peer}->{type} = $peertype
+      if (defined $peertype);
+
+    return $ret;
   };
 
 

diff --git a/msva-query-agent b/msva-query-agent
index c4235a3387fbef8cac3c110b45a0416f463ca54a..4285391ab949ff87fe92998e35d92292f785b706 100755 (executable)
--- a/msva-query-agent
+++ b/msva-query-agent
@@ -24,6 +24,7 @@ use Crypt::Monkeysphere::MSVA::Client;
 my $context = shift;
 my $peer = shift;
 my $pkctype = shift;
+my $peertype = shift;
 
 # load raw pkc data from stdin
 my $pkcdata = do {
@@ -36,7 +37,7 @@ my $client = Crypt::Monkeysphere::MSVA::Client->new(
                                                     log_level => $ENV{MSVA_LOG_LEVEL},
                                                    );
 
-my ($status,$ret) = $client->query_agent($context,$peer,$pkctype,$pkcdata);
+my ($status,$ret) = $client->query_agent($context,$peer,$peertype,$pkctype,$pkcdata);
 
 $client->log('info', "status: %s\n", $status);
 if (defined $ret) {
@@ -56,7 +57,7 @@ msva-query-agent - query a Monkeysphere Validation Agent
 
 =head1 SYNOPSIS
 
-msva-query-agent CONTEXT PEER PKC_TYPE < /path/to/public_key_carrier
+msva-query-agent CONTEXT PEER PKC_TYPE [PEERTYPE] < /path/to/public_key_carrier
 
 =head1 ABSTRACT
 
@@ -71,8 +72,8 @@ indicates the validity (as determined by the agent) of the certificate
 for the specified purpose.  The agent's return message (if any) is
 emitted on stdout.
 
-Three command-line arguments are all required, supplied in order, as
-follows:
+The first three command-line arguments are all required, supplied in
+order, as follows:
 
 =over 4
 
@@ -93,6 +94,16 @@ The format of public key carrier data provided on standard input
 
 =back
 
+The fourth argument is optional:
+
+= over 4
+
+=item PEERTYPE
+
+The type of peer we are inquiring about (e.g. 'client', 'server')
+
+=back
+
 =head1 RETURN CODE
 
 If the certificate is valid for the requested peer in the given