PERL-807: Implement Initial DNS Seedlist discovery spec

Makefile.PL

@@ -37,6 +37,7 @@ requires 'List::Util';
 requires 'MIME::Base64';
 requires 'Moo' => '2';
 requires 'Moo::Role';
+requires 'Net::DNS';
 requires 'Safe::Isa';
 requires 'Scalar::Util';
 requires 'Socket';

devel/config/replicaset-any-27017.yml

@@ -1,13 +1,13 @@
 ---
 type: replica
-setName: foo
-default_args: -v --noprealloc --nojournal --smallfiles --bind_ip 0.0.0.0 --nssize 6 --quiet
+setName: repl0
+default_args: -v --bind_ip 0.0.0.0 --quiet
 mongod:
     - name: host1
       port_override: 27017
     - name: host2
+      port_override: 27018
     - name: host3
-      rs_config:
-          arbiterOnly: true
+      port_override: 27019
 
 # vim: ts=4 sts=4 sw=4 et:

devel/lib/MongoDBTest/ReplicaSet.pm

@@ -43,7 +43,7 @@ has client => (
 
 sub _build_client {
     my ($self) = @_;
-    return MongoDB::MongoClient->new( host => $self->as_uri, dt_type => undef );
+    return $self->get_client;
 }
 
 has 'keyfile' => (
@@ -62,6 +62,7 @@ sub _build_keyfile {
 after 'start' => sub {
     my ($self) = @_;
     $self->rs_initiate;
+    $self->wait_for_primary;
 };
 
 # override to only set up auth on the first server
@@ -123,16 +124,13 @@ sub rs_initiate {
 
     # not $self->client because this needs to be a direct connection, i.e. one
     # seed and no replicaSet URI option
-    my $uri = $first->as_uri_with_auth;
 
-    my $client = MongoDB::MongoClient->new( host => $uri, dt_type => undef, );
+    my $client = $first->get_direct_client;
 
     $client->get_database("admin")->run_command({ismaster => 1});
 
     $client->get_database("admin")->run_command({replSetInitiate => $rs_config});
 
-    $self->_logger->debug("waiting for primary");
-
     $self->wait_for_primary;
 
     return;
@@ -142,7 +140,7 @@ sub wait_for_all_hosts {
     my ($self) = @_;
     my ($first) = $self->all_servers;
     retry {
-        my $client = MongoDB::MongoClient->new( host => $first->as_uri_with_auth, dt_type => undef );
+        my $client = $first->get_direct_client;
         my $admin = $client->get_database("admin");
         if ( my $status = eval { $admin->run_command({replSetGetStatus => 1}) } ) {
             my @member_states = map { $_->{state} } @{ $status->{members} };
@@ -164,12 +162,14 @@ sub wait_for_all_hosts {
 }
 
 sub wait_for_primary {
-    my ($self) = @_;
+    my ($self)  = @_;
     my ($first) = $self->all_servers;
+    my $uri = $first->as_uri_with_auth;
+    $self->_logger->debug("Waiting from primary on URI: $uri");
     retry {
-        my $client = MongoDB::MongoClient->new( host => $first->as_uri_with_auth, dt_type => undef );
-        my $admin = $client->get_database("admin");
-        if ( my $status = eval { $admin->run_command({replSetGetStatus => 1}) } ) {
+        my $client = $first->get_direct_client;
+        my $admin  = $client->get_database("admin");
+        if ( my $status = eval { $admin->run_command( { replSetGetStatus => 1 } ) } ) {
             my @member_states = map { $_->{state} } @{ $status->{members} };
             $self->_logger->debug("host states: @member_states");
             die "No PRIMARY\n"

devel/lib/MongoDBTest/Role/Server.pm

@@ -21,6 +21,7 @@ package MongoDBTest::Role::Server;
 use MongoDB;
 
 use CPAN::Meta::Requirements;
+use JSON;
 use Path::Tiny;
 use POSIX qw/SIGTERM SIGKILL/;
 use Proc::Guard;
@@ -364,22 +365,10 @@ sub _local_restart {
     my ($self) = @_;
     my $port = $self->port;
     # must be localhost for shutdown command
-    my @args = (
-        host    => "mongodb://localhost:$port",
-        connect_type => 'direct',
-        dt_type => undef,
-    );
-    if ( my $ssl = $self->ssl_config ) {
-        my $ssl_arg = {};
-        $ssl_arg->{SSL_verifycn_scheme} = 'none';
-        $ssl_arg->{SSL_ca_file} = $ssl->{certs}{ca}
-          if $ssl->{certs}{ca};
-        $ssl_arg->{SSL_verifycn_name} = $ssl->{servercn}
-          if $ssl->{servercn};
-        push @args, ssl => $ssl_arg;
-    }
+    my $uri = "mongodb://localhost:$port";
     eval {
-        MongoDB::MongoClient->new( @args )->get_database("admin")->run_command( [ shutdown => 1 ] );
+        my $client = $self->get_direct_client($uri, connect_type => 'direct');
+        $client->get_database("admin")->run_command( [ shutdown => 1 ] );
     };
     my $err = $@;
     # 'shutdown' closes the socket so we don't get a network error instead
@@ -414,6 +403,29 @@ sub stop {
     $self->_logger->debug("cleared guard and client for " . $self->name);
 }
 
+sub get_direct_client {
+    my ($self, $uri, @args) = @_;
+    $uri //= $self->as_uri_with_auth;
+    my $config = { host => $uri, dt_type => undef, @args };
+    if ( my $ssl = $self->ssl_config ) {
+        my $ssl_arg = {};
+        $ssl_arg->{SSL_verifycn_scheme} = 'none';
+        $ssl_arg->{SSL_ca_file}         = $ssl->{certs}{ca}
+          if $ssl->{certs}{ca};
+        $ssl_arg->{SSL_verifycn_name} = $ssl->{servercn}
+          if $ssl->{servercn};
+        $ssl_arg->{SSL_hostname} = $ssl->{servercn}
+          if $ssl->{servercn};
+        if ( $self->did_ssl_auth_setup ) {
+            $config->{username}       = $ssl->{username};
+            $config->{auth_mechanism} = 'MONGODB-X509';
+            $ssl_arg->{SSL_cert_file} = $ssl->{certs}{client};
+        }
+        $config->{ssl} = $ssl_arg;
+    }
+    return MongoDB::MongoClient->new($config);
+}
+
 sub is_alive {
     my ($self) = @_;
     return unless $self->has_guard;

devel/lib/MongoDBTest/Role/ServerSet.pm

@@ -21,6 +21,7 @@ package MongoDBTest::Role::ServerSet;
 use MongoDBTest::Mongod;
 use MongoDBTest::Mongos;
 
+use JSON;
 use Moo::Role;
 use Types::Standard -types;
 use namespace::clean;
@@ -113,6 +114,30 @@ sub get_server {
     return;
 }
 
+sub get_client {
+    my ($self) = @_;
+    my $config = { host => $self->as_uri, dt_type => undef };
+    if ( my $ssl = $self->ssl_config ) {
+        my $ssl_arg = {};
+        $ssl_arg->{SSL_verifycn_scheme} = 'none';
+        $ssl_arg->{SSL_ca_file}         = $ssl->{certs}{ca}
+          if $ssl->{certs}{ca};
+        $ssl_arg->{SSL_verifycn_name} = $ssl->{servercn}
+          if $ssl->{servercn};
+        $ssl_arg->{SSL_hostname} = $ssl->{servercn}
+          if $ssl->{servercn};
+        if ($ssl->{username}) {
+            $config->{username}       = $ssl->{username};
+            $config->{auth_mechanism} = 'MONGODB-X509';
+            $ssl_arg->{SSL_cert_file} = $ssl->{certs}{client};
+        }
+        $config->{ssl} = $ssl_arg;
+    }
+    $self->_logger->debug("connecting to server with: " . to_json($config));
+
+    return MongoDB::MongoClient->new($config);
+}
+
 sub start {
     my ($self) = @_;
     # XXX eventually factor out wait_port from server->start, start all servers

devel/lib/MongoDBTest/ShardedCluster.pm

@@ -23,6 +23,7 @@ use MongoDBTest::Deployment;
 use MongoDBTest::ServerSet;
 use MongoDBTest::Mongod;
 
+use JSON;
 use Moo;
 use Try::Tiny::Retry qw/:all/;
 use Types::Standard -types;
@@ -119,7 +120,12 @@ sub start {
     my $uri = $self->routers->as_uri;
     $self->_logger->debug("connecting to mongos at $uri");
     my $client =
-        retry { MongoDB::MongoClient->new( host => $uri ) }
+        retry {
+            my $client = $self->get_client;
+            $client->db("admin")->run_command({ismaster => 1});
+            $client
+        }
+        on_retry { $self->_logger->debug($_) }
         delay_exp { 15, 1e4 }
         catch { chomp; die "$_. Giving up!\n" };
 
@@ -173,6 +179,30 @@ sub get_server {
     return;
 }
 
+sub get_client {
+    my ($self) = @_;
+    my $config = { host => $self->as_uri, dt_type => undef };
+    if ( my $ssl = $self->ssl_config ) {
+        my $ssl_arg = {};
+        $ssl_arg->{SSL_verifycn_scheme} = 'none';
+        $ssl_arg->{SSL_ca_file}         = $ssl->{certs}{ca}
+          if $ssl->{certs}{ca};
+        $ssl_arg->{SSL_verifycn_name} = $ssl->{servercn}
+          if $ssl->{servercn};
+        $ssl_arg->{SSL_hostname} = $ssl->{servercn}
+          if $ssl->{servercn};
+        if ($ssl->{username}) {
+            $config->{username}       = $ssl->{username};
+            $config->{auth_mechanism} = 'MONGODB-X509';
+            $ssl_arg->{SSL_cert_file} = $ssl->{certs}{client};
+        }
+        $config->{ssl} = $ssl_arg;
+    }
+    $self->_logger->debug("connecting to server with: " . to_json($config));
+
+    return MongoDB::MongoClient->new($config);
+}
+
 with 'MooseX::Role::Logger', 'MongoDBTest::Role::Deployment';
 
 1;

devel/t-dynamic/PERL-807-DNS-SRV-TXT.t

@@ -0,0 +1,131 @@
+#
+#  Copyright 2009-2013 MongoDB, Inc.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#  http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+#
+
+use strict;
+use warnings;
+use JSON::MaybeXS;
+use YAML::XS qw/LoadFile DumpFile/;
+use Path::Tiny 0.054; # basename with suffix
+use Test::More 0.88;
+use Test::Fatal;
+use Try::Tiny;
+use Sys::Hostname;
+
+use lib "t/lib";
+use lib "devel/lib";
+
+use if $ENV{MONGOVERBOSE}, qw/Log::Any::Adapter Stderr/;
+
+use MongoDBTest::Orchestrator;
+
+use MongoDBTest qw/build_client get_test_db clear_testdbs server_version
+  server_type skip_if_mongod skip_unless_mongod/;
+
+# This test starts servers on localhost ports 27017, 27018 and 27019. We skip if
+# these aren't available.
+for my $port ( 27017, 27018, 27019 ) {
+    local $ENV{MONGOD} = "mongodb://localhost:$port/";
+    skip_if_mongod();
+}
+
+my $cert_dir = $ENV{MONGO_TEST_CERT_PATH} || 'devel/certs';
+my $cert_user = $ENV{MONGO_TEST_CERT_USER}
+  || "CN=client,OU=Drivers,O=MongoDB,L=New York,ST=New York,C=US";
+my $server_cn = "CN=localhost,OU=Server,O=MongoDB,L=New York,ST=New York,C=US";
+
+my %certs = (
+    client    => "$cert_dir/client.pem",
+    ca        => "$cert_dir/ca.pem",
+    server    => "$cert_dir/server.pem",
+);
+
+my $config  = LoadFile("devel/config/replicaset-any-27017.yml");
+$config->{ssl_config} = {
+    # not require, as need to connect without SSL for one of the tests
+    mode     => 'preferSSL',
+    servercn => $server_cn,
+    certs    => { map { $_ => $certs{$_} } qw/server ca client/ },
+};
+my $config_path = Path::Tiny->tempfile;
+DumpFile( "$config_path", $config );
+
+my $orc =
+  MongoDBTest::Orchestrator->new(
+    config_file => "$config_path" );
+$orc->start;
+
+sub new_client {
+    my $host = shift;
+    return build_client(
+        host    => $host,
+        dt_type => undef,
+        ssl            => {
+            SSL_ca_file         => $certs{ca},
+            SSL_verifycn_scheme => 'none',
+        },
+    );
+}
+
+sub run_test {
+    my $test = shift;
+
+    if ( $test->{error} ) {
+        # This test should error the parsing step at some point
+        isnt( exception { new_client( $test->{uri} ) }, undef,
+            "invalid uri" );
+        return;
+    }
+
+    my $mongo;
+    try {
+      $mongo = new_client( $test->{uri} );
+    };
+    isa_ok( $mongo, 'MongoDB::MongoClient' );
+    # drop out of test to save on undef errors - its already failed
+    return unless defined $mongo;
+    my $uri = $mongo->_uri;
+
+    my $lc_opts = { map { lc $_ => $test->{options}->{$_} } keys %{ $test->{options} } };
+    # force ssl JSON boolean to perlish
+    $lc_opts->{ssl} = $lc_opts->{ssl} ? 1 : 0;
+    is_deeply( $uri->options, $lc_opts, "options are correct" );
+    is_deeply( [ sort @{ $uri->hostids } ], [ sort @{ $test->{seeds} } ], "seeds are correct" );
+    my $topology = $mongo->topology_status( refresh => 1 );
+    my @found_servers = map { $_->{address} } @{ $topology->{servers} };
+    my $hostname = hostname();
+    my @wanted_servers = map { ( my $h = $_ ) =~ s/localhost/$hostname/; $h } @{ $test->{hosts} };
+    is_deeply( [ sort @found_servers ], [ sort @wanted_servers ], "hosts are correct" );
+}
+
+my $dir      = path("t/data/initial_dns_seedlist_discovery");
+my $iterator = $dir->iterator;
+while ( my $path = $iterator->() ) {
+    next unless $path =~ /\.json$/;
+    my $plan = eval { decode_json( $path->slurp_utf8 ) };
+    if ($@) {
+        die "Error decoding $path: $@";
+    }
+    subtest $path => sub {
+        my $description = $plan->{comment};
+        subtest $description => sub {
+            run_test( $plan );
+        }
+    };
+}
+
+clear_testdbs;
+
+done_testing;