From 99a8f970d6d9416ac4032a353cfe2739344d8b92 Mon Sep 17 00:00:00 2001
From: David Golden <xdg@xdg.me>
Date: Thu, 14 Dec 2017 15:27:13 -0500
Subject: [PATCH 1/8] PERL-807 Create orchestrated test stub for SRV/TXT
 testing

---
 devel/config/replicaset-any-27017.yml  |  8 ++--
 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t | 56 ++++++++++++++++++++++++++
 t/lib/MongoDBTest.pm                   | 15 ++++++-
 3 files changed, 74 insertions(+), 5 deletions(-)
 create mode 100644 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t

diff --git a/devel/config/replicaset-any-27017.yml b/devel/config/replicaset-any-27017.yml
index 57af9ffc..1b82cb06 100644
--- a/devel/config/replicaset-any-27017.yml
+++ b/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:
diff --git a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
new file mode 100644
index 00000000..94ca48db
--- /dev/null
+++ b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
@@ -0,0 +1,56 @@
+#
+#  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 Test::More 0.88;
+use Test::Fatal;
+
+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 $orc =
+  MongoDBTest::Orchestrator->new(
+    config_file => "devel/config/replicaset-any-27017.yml" );
+$orc->start;
+$ENV{MONGOD} = $orc->as_uri;
+
+my $client         = build_client( server_selection_timeout_ms => 5000 );
+my $testdb         = get_test_db($client);
+my $server_version = server_version($client);
+my $server_type    = server_type($client);
+my $coll           = $testdb->get_collection('test_collection');
+
+subtest "Add tests here" => sub {
+    ok( $coll->insert_one( {} ), "We can insert" );
+};
+
+clear_testdbs;
+done_testing;
diff --git a/t/lib/MongoDBTest.pm b/t/lib/MongoDBTest.pm
index 5816b598..528cd326 100644
--- a/t/lib/MongoDBTest.pm
+++ b/t/lib/MongoDBTest.pm
@@ -29,7 +29,7 @@ use version;
 
 our @EXPORT_OK = qw(
   build_client get_test_db server_version server_type clear_testdbs get_capped
-  skip_unless_mongod uri_escape get_unique_collection
+  skip_unless_mongod skip_if_mongod uri_escape get_unique_collection
 );
 
 my @testdbs;
@@ -123,6 +123,19 @@ sub skip_unless_mongod {
     }
 }
 
+sub skip_if_mongod {
+    eval {
+        my $conn = build_client( server_selection_timeout_ms => 1000 );
+        my $topo = $conn->_topology;
+        $topo->scan_all_servers;
+        # will throw if no servers available
+        $topo->get_readable_link(MongoDB::ReadPreference->new({mode => 'nearest'}));
+    };
+    if ( ! $@ ) {
+        plan skip_all => "Test can't start with a running mongod";
+    }
+}
+
 sub server_version {
 
     my $conn = shift;

From 33e7a9ace72cc79041426f118021d033430877ba Mon Sep 17 00:00:00 2001
From: Thomas Bloor <tbsliver@shadow.cat>
Date: Fri, 15 Dec 2017 20:54:04 +0000
Subject: [PATCH 2/8] PERL-807 Initial pass of work, need SSL on the framework
 though

---
 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t        |  51 ++++-
 lib/MongoDB/MongoClient.pm                    |   2 +-
 lib/MongoDB/_URI.pm                           | 194 +++++++++++++++---
 .../initial_dns_seedlist_discovery/README.rst |  87 ++++++++
 .../longer-parent-in-return.json              |  16 ++
 .../longer-parent-in-return.yml               |  11 +
 .../misformatted-option.json                  |   7 +
 .../misformatted-option.yml                   |   5 +
 .../no-results.json                           |   7 +
 .../no-results.yml                            |   5 +
 .../not-enough-parts.json                     |   7 +
 .../not-enough-parts.yml                      |   5 +
 .../one-result-default-port.json              |  15 ++
 .../one-result-default-port.yml               |  10 +
 .../one-txt-record-multiple-strings.json      |  15 ++
 .../one-txt-record-multiple-strings.yml       |  10 +
 .../one-txt-record.json                       |  16 ++
 .../one-txt-record.yml                        |  11 +
 .../parent-part-mismatch1.json                |   7 +
 .../parent-part-mismatch1.yml                 |   5 +
 .../parent-part-mismatch2.json                |   7 +
 .../parent-part-mismatch2.yml                 |   5 +
 .../parent-part-mismatch3.json                |   7 +
 .../parent-part-mismatch3.yml                 |   5 +
 .../parent-part-mismatch4.json                |   7 +
 .../parent-part-mismatch4.yml                 |   5 +
 .../parent-part-mismatch5.json                |   7 +
 .../parent-part-mismatch5.yml                 |   5 +
 .../returned-parent-too-short.json            |   7 +
 .../returned-parent-too-short.yml             |   5 +
 .../returned-parent-wrong.json                |   7 +
 .../returned-parent-wrong.yml                 |   5 +
 .../two-results-default-port.json             |  16 ++
 .../two-results-default-port.yml              |  11 +
 .../two-results-nonstandard-port.json         |  16 ++
 .../two-results-nonstandard-port.yml          |  11 +
 .../two-txt-records.json                      |   7 +
 .../two-txt-records.yml                       |   5 +
 .../txt-record-not-allowed-option.json        |   7 +
 .../txt-record-not-allowed-option.yml         |   5 +
 ...txt-record-with-overridden-ssl-option.json |  16 ++
 .../txt-record-with-overridden-ssl-option.yml |  11 +
 ...txt-record-with-overridden-uri-option.json |  16 ++
 .../txt-record-with-overridden-uri-option.yml |  11 +
 .../txt-record-with-unallowed-option.json     |   7 +
 .../txt-record-with-unallowed-option.yml      |   5 +
 .../uri-with-port.json                        |   7 +
 .../uri-with-port.yml                         |   5 +
 .../uri-with-two-hosts.json                   |   7 +
 .../uri-with-two-hosts.yml                    |   5 +
 50 files changed, 682 insertions(+), 44 deletions(-)
 create mode 100644 t/data/initial_dns_seedlist_discovery/README.rst
 create mode 100644 t/data/initial_dns_seedlist_discovery/longer-parent-in-return.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/longer-parent-in-return.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/misformatted-option.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/misformatted-option.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/no-results.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/no-results.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/not-enough-parts.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/not-enough-parts.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-result-default-port.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-result-default-port.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-txt-record.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/one-txt-record.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/returned-parent-too-short.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/returned-parent-too-short.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/returned-parent-wrong.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/returned-parent-wrong.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-results-default-port.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-results-default-port.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-txt-records.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/two-txt-records.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/uri-with-port.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/uri-with-port.yml
 create mode 100644 t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.json
 create mode 100644 t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.yml

diff --git a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
index 94ca48db..da24f7cd 100644
--- a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
+++ b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
@@ -16,6 +16,8 @@
 
 use strict;
 use warnings;
+use JSON::MaybeXS;
+use Path::Tiny 0.054; # basename with suffix
 use Test::More 0.88;
 use Test::Fatal;
 
@@ -40,17 +42,48 @@ my $orc =
   MongoDBTest::Orchestrator->new(
     config_file => "devel/config/replicaset-any-27017.yml" );
 $orc->start;
-$ENV{MONGOD} = $orc->as_uri;
 
-my $client         = build_client( server_selection_timeout_ms => 5000 );
-my $testdb         = get_test_db($client);
-my $server_version = server_version($client);
-my $server_type    = server_type($client);
-my $coll           = $testdb->get_collection('test_collection');
+sub run_test {
+    my $test = shift;
+
+    if ( $test->{error} ) {
+        # This test should error the parsing step at some point
+        isnt( exception { MongoDB->connect( $test->{uri} ) }, undef,
+            "invalid uri" );
+        return;
+    }
+
+    use Devel::Dwarn;
+    Dwarn $test;
+    my $mongo = MongoDB->connect( $test->{uri} );
+    isa_ok( $mongo, 'MongoDB::MongoClient' );
+    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" );
+    Dwarn $mongo->topology_status( refresh => 1 );
+}
+
+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 );
+        }
+    };
+    last;
+}
 
-subtest "Add tests here" => sub {
-    ok( $coll->insert_one( {} ), "We can insert" );
-};
 
 clear_testdbs;
 done_testing;
diff --git a/lib/MongoDB/MongoClient.pm b/lib/MongoDB/MongoClient.pm
index eacdd360..d1ae5d05 100644
--- a/lib/MongoDB/MongoClient.pm
+++ b/lib/MongoDB/MongoClient.pm
@@ -1198,7 +1198,7 @@ has _uri => (
 
 sub _build__uri {
     my ($self) = @_;
-    if ( $self->host =~ m{^\w+://} ) {
+    if ( $self->host =~ m{^[\w\+]+://} ) {
         return MongoDB::_URI->new( uri => $self->host );
     }
     else {
diff --git a/lib/MongoDB/_URI.pm b/lib/MongoDB/_URI.pm
index 94e78189..9b82f0e8 100644
--- a/lib/MongoDB/_URI.pm
+++ b/lib/MongoDB/_URI.pm
@@ -33,7 +33,7 @@ use namespace::clean -except => 'meta';
 
 my $uri_re =
     qr{
-            mongodb://
+            mongodb(?:\+srv|)://
             (?: ([^:]*) (?: : ([^@]*) )? @ )? # [username(:password)?@]
             ([^/?]*) # host1[:port1][,host2[:port2],...[,hostN[:portN]]]
             (?:
@@ -120,6 +120,21 @@ sub _build_valid_options {
     };
 }
 
+has valid_srv_options => (
+    is => 'ro',
+    isa => HashRef,
+    builder => '_build_valid_srv_options',
+);
+
+sub _build_valid_srv_options {
+    return {
+        map { lc($_) => 1 } qw(
+            authSource
+            replicaSet
+        )
+    };
+}
+
 sub _unescape_all {
     my $str = shift;
     return '' unless defined $str;
@@ -141,12 +156,155 @@ sub _parse_doc {
     return $set;
 }
 
+use Devel::Dwarn;
+sub _parse_options {
+    my ( $self, $valid, $result, $err_unsupported ) = @_;
+
+    my %parsed;
+    for my $opt ( split '&', $result->{options} ) {
+        my @kv = split '=', $opt, -1;
+        MongoDB::UsageError->throw("expected key value pair") unless @kv == 2;
+        my ( $k, $v ) = map { _unescape_all($_) } @kv;
+        # connection string spec calls for case normalization
+        ( my $lc_k = $k ) =~ tr[A-Z][a-z];
+        if ( !$valid->{$lc_k} ) {
+            if ( $err_unsupported ) {
+                MongoDB::Error->throw("Unsupported option '$k' in URI $self\n");
+            } else {
+                warn "Unsupported option '$k' in URI $self\n";
+            }
+            next;
+        }
+        if ( exists $parsed{$lc_k} && !exists $options_with_list_type{$lc_k} ) {
+            warn "Multiple options were found for the same value '$lc_k'\n";
+            next;
+        }
+        if ( $lc_k eq 'authmechanismproperties' ) {
+            $parsed{$lc_k} = _parse_doc( $k, $v );
+        }
+        elsif ( $lc_k eq 'authsource' ) {
+            $result->{db_name} = $v;
+            $parsed{$lc_k} = $v;
+        }
+        elsif ( $lc_k eq 'readpreferencetags' ) {
+            $parsed{$lc_k} ||= [];
+            push @{ $parsed{$lc_k} }, _parse_doc( $k, $v );
+        }
+        elsif ( $lc_k eq 'ssl' || $lc_k eq 'journal' || $lc_k eq 'serverselectiontryonce' ) {
+            $parsed{$lc_k} = __str_to_bool( $k, $v );
+        }
+        else {
+            $parsed{$lc_k} = $v;
+        }
+    }
+    return \%parsed;
+}
+
+sub _parse_srv_uri {
+    my ( $self, $uri ) = @_;
+
+    my %result;
+
+    $uri =~ m{^$uri_re$};
+
+    (
+        $result{username}, $result{password}, $result{hostids},
+        $result{db_name},  $result{options}
+    ) = ( $1, $2, $3, $4, $5 );
+
+    Dwarn \%result;
+    if ( defined $result{username} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a username if using an SRV connection string");
+    }
+
+    if ( defined $result{password} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a password if using an SRV connection string");
+    }
+
+    if ( defined $result{db_name} && length $result{db_name} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a database name if using an SRV connection string");
+    }
+
+    if ( !defined $result{hostids} || !length $result{hostids} ) {
+        MongoDB::Error->throw("URI '$self' cannot be empty if using an SRV connection string");
+    }
+
+    if ( $result{hostids} =~ /,/ ) {
+        MongoDB::Error->throw("URI '$self' cannot contain a comma or multiple host names if using an SRV connection string");
+    }
+
+    if ( defined $result{options} ) {
+        my $valid = $self->valid_options;
+        $result{options} = $self->_parse_options( $valid, \%result );
+    }
+
+    # TODO error on invalid domains
+
+    Dwarn \%result;
+
+    require Net::DNS;
+
+    my $res = Net::DNS::Resolver->new;
+    my $srv_data = $res->query( sprintf( '_mongodb._tcp.%s', $result{hostids} ), 'SRV' );
+
+    my @hosts;
+    my $options = {};
+
+    if ( $srv_data ) {
+        foreach my $rr ( $srv_data->answer ) {
+            next unless $rr->type eq 'SRV';
+            # TODO check url is correct?
+            push @hosts, {
+              target => $rr->target,
+              port   => $rr->port,
+            };
+        }
+        my $txt_data = $res->query( $result{hostids}, 'TXT' );
+        my @txt_answers;
+        foreach my $rr ( $txt_data->answer ) {
+            next unless $rr->type eq 'TXT';
+            push @txt_answers, $rr;
+        }
+        if ( scalar( @txt_answers ) > 1 ) {
+            MongoDB::Error->throw("URI '$self' returned more than one TXT result");
+        } elsif ( scalar( @txt_answers ) == 1 ) {
+            my @txt_data = $txt_answers[0]->txtdata;
+            my $txt_opt_string = join ( '', @txt_data );
+            Dwarn $txt_opt_string;
+            $options = $self->_parse_options( $self->valid_srv_options, { options => $txt_opt_string }, 1 );
+        }
+    } else {
+        MongoDB::Error->throw("URI '$self' does not return any SRV results");
+    }
+
+    # Default to SSL on unless specified in conn string options
+    $options = {
+      ssl => 'true',
+      %$options,
+      %{ $result{options} || {} },
+    };
+
+    my $new_uri = sprintf(
+        'mongodb://%s/%s%s',
+        join( ',', map { sprintf( '%s:%s', $_->{target}, $_->{port} ) } @hosts ),
+        scalar( keys %$options ) ? '?' : '',
+        join( '&', map { sprintf( '%s=%s', $_, $options->{$_} ) } keys %$options ),
+    );
+
+    Dwarn $new_uri;
+    return $new_uri;
+}
+
 sub BUILD {
     my ($self) = @_;
 
     my $uri = $self->uri;
     my %result;
 
+    if ( $uri =~ m{^mongodb\+srv://} ) {
+        $uri = $self->_parse_srv_uri( $uri );
+    }
+
     # we throw Error instead of UsageError for errors, to avoid stacktrace revealing credentials
     if ( $uri !~ m{^$uri_re$} ) {
         MongoDB::Error->throw("URI '$self' could not be parsed");
@@ -204,39 +362,7 @@ sub BUILD {
 
     if ( defined $result{options} ) {
         my $valid = $self->valid_options;
-        my %parsed;
-        for my $opt ( split '&', $result{options} ) {
-            my @kv = split '=', $opt, -1;
-            MongoDB::UsageError->throw("expected key value pair") unless @kv == 2;
-            my ( $k, $v ) = map { _unescape_all($_) } @kv;
-            # connection string spec calls for case normalization
-            ( my $lc_k = $k ) =~ tr[A-Z][a-z];
-            if ( !$valid->{$lc_k} ) {
-                warn "Unsupported option '$k' in URI $self\n";
-                next;
-            }
-            if ( exists $parsed{$lc_k} && !exists $options_with_list_type{$lc_k} ) {
-                warn "Multiple options were found for the same value '$lc_k'\n";
-                next;
-            }
-            if ( $lc_k eq 'authmechanismproperties' ) {
-                $parsed{$lc_k} = _parse_doc( $k, $v );
-            }
-            elsif ( $lc_k eq 'authsource' ) {
-                $result{db_name} = $v;
-            }
-            elsif ( $lc_k eq 'readpreferencetags' ) {
-                $parsed{$lc_k} ||= [];
-                push @{ $parsed{$lc_k} }, _parse_doc( $k, $v );
-            }
-            elsif ( $lc_k eq 'ssl' || $lc_k eq 'journal' || $lc_k eq 'serverselectiontryonce' ) {
-                $parsed{$lc_k} = __str_to_bool( $k, $v );
-            }
-            else {
-                $parsed{$lc_k} = $v;
-            }
-        }
-        $result{options} = \%parsed;
+        $result{options} = $self->_parse_options( $valid, \%result );
     }
 
     for my $attr (qw/username password db_name options hostids/) {
diff --git a/t/data/initial_dns_seedlist_discovery/README.rst b/t/data/initial_dns_seedlist_discovery/README.rst
new file mode 100644
index 00000000..5b093e19
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/README.rst
@@ -0,0 +1,87 @@
+====================================
+Initial DNS Seedlist Discovery tests
+====================================
+
+This directory contains platform-independent tests that drivers can use
+to prove their conformance to the Initial DNS Seedlist Discovery spec.
+
+Test Setup
+----------
+
+Start a three-node replica set on localhost, on ports 27017, 27018, and 27019,
+with replica set name "repl0". The replica set MUST be started with SSL
+enabled.
+
+To run the tests that accompany this spec, you need to configure the SRV and
+TXT records with a real name server. The following records are required for
+these tests::
+
+  Record                                    TTL    Class   Address
+  localhost.test.build.10gen.cc.            86400  IN A    127.0.0.1
+  localhost.sub.test.build.10gen.cc.        86400  IN A    127.0.0.1
+
+  Record                                    TTL    Class   Port   Target
+  _mongodb._tcp.test1.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test1.test.build.10gen.cc.  86400  IN SRV  27018  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test2.test.build.10gen.cc.  86400  IN SRV  27018  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test2.test.build.10gen.cc.  86400  IN SRV  27019  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test3.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test5.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test6.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test7.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test8.test.build.10gen.cc.  86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test10.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test11.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.build.10gen.cc.
+  _mongodb._tcp.test12.test.build.10gen.cc. 86400  IN SRV  27017  localhost.build.10gen.cc.
+  _mongodb._tcp.test13.test.build.10gen.cc. 86400  IN SRV  27017  test.build.10gen.cc.
+  _mongodb._tcp.test14.test.build.10gen.cc. 86400  IN SRV  27017  localhost.not-test.build.10gen.cc.
+  _mongodb._tcp.test15.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.not-build.10gen.cc.
+  _mongodb._tcp.test16.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.build.not-10gen.cc.
+  _mongodb._tcp.test17.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.build.10gen.not-cc.
+  _mongodb._tcp.test18.test.build.10gen.cc. 86400  IN SRV  27017  localhost.sub.test.build.10gen.cc.
+  _mongodb._tcp.test19.test.build.10gen.cc. 86400  IN SRV  27017  localhost.evil.build.10gen.cc.
+  _mongodb._tcp.test19.test.build.10gen.cc. 86400  IN SRV  27017  localhost.test.build.10gen.cc.
+
+  Record                                    TTL    Class   Text
+  test5.test.build.10gen.cc.                86400  IN TXT  "replicaSet=repl0&authSource=thisDB"
+  test6.test.build.10gen.cc.                86400  IN TXT  "replicaSet=repl0"
+  test6.test.build.10gen.cc.                86400  IN TXT  "authSource=otherDB"
+  test7.test.build.10gen.cc.                86400  IN TXT  "ssl=false"
+  test8.test.build.10gen.cc.                86400  IN TXT  "authSource"
+  test10.test.build.10gen.cc.               86400  IN TXT  "socketTimeoutMS=500"
+  test11.test.build.10gen.cc.               86400  IN TXT  "replicaS" "et=rep" "l0"
+
+Note that ``test4`` is omitted deliberately to test what happens with no SRV
+record. ``test9`` is missing because it was deleted during the development of
+the tests. The missing ``test.`` sub-domain in the SRV record target for
+``test12`` is deliberate.
+
+In our tests we have used ``localhost.test.build.10gen.cc`` as the domain, and
+then configured ``localhost.test.build.10gen.cc`` to resolve to 127.0.0.1.
+
+You need to adapt the records shown above to replace ``test.build.10gen.cc``
+with your own domain name, and update the "uri" field in the YAML or JSON files
+in this directory with the actual domain.
+
+Test Format and Use
+-------------------
+
+These YAML and JSON files contain the following fields:
+
+- ``uri``: a mongodb+srv connection string
+- ``seeds``: the expected set of initial seeds discovered from the SRV record
+- ``hosts``: the discovered topology's list of hosts once SDAM completes a scan
+- ``options``: the parsed connection string options as discovered from URI and
+  TXT records
+- ``error``: indicates that the parsing of the URI, or the resolving or
+  contents of the SRV or TXT records included errors.
+- ``comment``: a comment to indicate why a test would fail.
+
+For each file, create MongoClient initialized with the mongodb+srv connection
+string. You SHOULD verify that the client's initial seed list matches the list of
+seeds. You MUST verify that the set of ServerDescriptions in the client's
+TopologyDescription eventually matches the list of hosts. You MUST verify that
+each of the values of the Connection String Options under ``options`` match the
+Client's parsed value for that option. There may be other options parsed by
+the Client as well, which a test does not verify. You MUST verify that an
+error has been thrown if ``error`` is present.
diff --git a/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.json b/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.json
new file mode 100644
index 00000000..9a8267ea
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test18.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [
+    "localhost.sub.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "ssl": true
+  },
+  "comment": "Is correct, as returned host name shared the URI root \"test.build.10gen.cc\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.yml b/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.yml
new file mode 100644
index 00000000..e77c4570
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/longer-parent-in-return.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test18.test.build.10gen.cc/?replicaSet=repl0"
+seeds:
+    - localhost.sub.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    ssl: true
+comment: Is correct, as returned host name shared the URI root "test.build.10gen.cc".
diff --git a/t/data/initial_dns_seedlist_discovery/misformatted-option.json b/t/data/initial_dns_seedlist_discovery/misformatted-option.json
new file mode 100644
index 00000000..3c8c29ac
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/misformatted-option.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test8.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because the options in the TXT record are incorrectly formatted (misses value)."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/misformatted-option.yml b/t/data/initial_dns_seedlist_discovery/misformatted-option.yml
new file mode 100644
index 00000000..9669772c
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/misformatted-option.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test8.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because the options in the TXT record are incorrectly formatted (misses value).
diff --git a/t/data/initial_dns_seedlist_discovery/no-results.json b/t/data/initial_dns_seedlist_discovery/no-results.json
new file mode 100644
index 00000000..c1dc02d2
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/no-results.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test4.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because no SRV records are present for this URI."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/no-results.yml b/t/data/initial_dns_seedlist_discovery/no-results.yml
new file mode 100644
index 00000000..e09bd060
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/no-results.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test4.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because no SRV records are present for this URI.
diff --git a/t/data/initial_dns_seedlist_discovery/not-enough-parts.json b/t/data/initial_dns_seedlist_discovery/not-enough-parts.json
new file mode 100644
index 00000000..7cfce2ec
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/not-enough-parts.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because host in URI does not have {hostname}, {domainname} and {tld}."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/not-enough-parts.yml b/t/data/initial_dns_seedlist_discovery/not-enough-parts.yml
new file mode 100644
index 00000000..b36fa4a5
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/not-enough-parts.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because host in URI does not have {hostname}, {domainname} and {tld}.
diff --git a/t/data/initial_dns_seedlist_discovery/one-result-default-port.json b/t/data/initial_dns_seedlist_discovery/one-result-default-port.json
new file mode 100644
index 00000000..cebb3b1e
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-result-default-port.json
@@ -0,0 +1,15 @@
+{
+  "uri": "mongodb+srv://test3.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/one-result-default-port.yml b/t/data/initial_dns_seedlist_discovery/one-result-default-port.yml
new file mode 100644
index 00000000..395bcdc9
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-result-default-port.yml
@@ -0,0 +1,10 @@
+uri: "mongodb+srv://test3.test.build.10gen.cc/?replicaSet=repl0"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.json b/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.json
new file mode 100644
index 00000000..622668c3
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.json
@@ -0,0 +1,15 @@
+{
+  "uri": "mongodb+srv://test11.test.build.10gen.cc/",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.yml b/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.yml
new file mode 100644
index 00000000..90a702cd
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-txt-record-multiple-strings.yml
@@ -0,0 +1,10 @@
+uri: "mongodb+srv://test11.test.build.10gen.cc/"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/one-txt-record.json b/t/data/initial_dns_seedlist_discovery/one-txt-record.json
new file mode 100644
index 00000000..2385021a
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-txt-record.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test5.test.build.10gen.cc/",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "authSource": "thisDB",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/one-txt-record.yml b/t/data/initial_dns_seedlist_discovery/one-txt-record.yml
new file mode 100644
index 00000000..9356eaa2
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/one-txt-record.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test5.test.build.10gen.cc/"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    authSource: thisDB
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.json b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.json
new file mode 100644
index 00000000..8d0147a4
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test14.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name's part \"not-test\" mismatches URI parent part \"test\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.yml b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.yml
new file mode 100644
index 00000000..e35dfdf6
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch1.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test14.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name's part "not-test" mismatches URI parent part "test".
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.json b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.json
new file mode 100644
index 00000000..996249eb
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test15.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name's part \"not-build\" mismatches URI parent part \"build\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.yml b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.yml
new file mode 100644
index 00000000..595e5493
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch2.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test15.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name's part "not-build" mismatches URI parent part "build".
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.json b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.json
new file mode 100644
index 00000000..69e724af
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test16.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name's part \"not-10gen\" mismatches URI parent part \"10gen\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.yml b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.yml
new file mode 100644
index 00000000..64ca2e70
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch3.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test16.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name's part "not-10gen" mismatches URI parent part "10gen".
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.json b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.json
new file mode 100644
index 00000000..254168e3
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test17.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name's TLD \"not-cc\" mismatches URI TLD \"cc\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.yml b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.yml
new file mode 100644
index 00000000..226d6fa3
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch4.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test17.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name's TLD "not-cc" mismatches URI TLD "cc".
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.json b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.json
new file mode 100644
index 00000000..92c024b4
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test19.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because one of the returned host names' domain name parts \"evil\" mismatches \"test\"."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.yml b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.yml
new file mode 100644
index 00000000..1ed2bda4
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/parent-part-mismatch5.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test19.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because one of the returned host names' domain name parts "evil" mismatches "test".
diff --git a/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.json b/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.json
new file mode 100644
index 00000000..676eb0c0
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test13.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name's parent (build.10gen.cc) misses \"test.\""
+}
diff --git a/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.yml b/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.yml
new file mode 100644
index 00000000..397aec89
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/returned-parent-too-short.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test13.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name's parent (build.10gen.cc) misses "test."
diff --git a/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.json b/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.json
new file mode 100644
index 00000000..3aabfd81
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test12.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because returned host name is too short and mismatches a parent."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.yml b/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.yml
new file mode 100644
index 00000000..1fc3867a
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/returned-parent-wrong.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test12.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because returned host name is too short and mismatches a parent.
diff --git a/t/data/initial_dns_seedlist_discovery/two-results-default-port.json b/t/data/initial_dns_seedlist_discovery/two-results-default-port.json
new file mode 100644
index 00000000..66028310
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-results-default-port.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test1.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017",
+    "localhost.test.build.10gen.cc:27018"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/two-results-default-port.yml b/t/data/initial_dns_seedlist_discovery/two-results-default-port.yml
new file mode 100644
index 00000000..61d38b5e
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-results-default-port.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test1.test.build.10gen.cc/?replicaSet=repl0"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+    - localhost.test.build.10gen.cc:27018
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.json b/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.json
new file mode 100644
index 00000000..4900f7cf
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test2.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27018",
+    "localhost.test.build.10gen.cc:27019"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.yml b/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.yml
new file mode 100644
index 00000000..7185f52c
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-results-nonstandard-port.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test2.test.build.10gen.cc/?replicaSet=repl0"
+seeds:
+    - localhost.test.build.10gen.cc:27018
+    - localhost.test.build.10gen.cc:27019
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/two-txt-records.json b/t/data/initial_dns_seedlist_discovery/two-txt-records.json
new file mode 100644
index 00000000..f0654ef6
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-txt-records.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test6.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because there are two TXT records."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/two-txt-records.yml b/t/data/initial_dns_seedlist_discovery/two-txt-records.yml
new file mode 100644
index 00000000..c6093613
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/two-txt-records.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test6.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because there are two TXT records.
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.json b/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.json
new file mode 100644
index 00000000..2a5cf2f0
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test10.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because socketTimeoutMS is not an allowed option."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.yml b/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.yml
new file mode 100644
index 00000000..f4ff1cfd
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-not-allowed-option.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test10.test.build.10gen.cc/?replicaSet=repl0"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because socketTimeoutMS is not an allowed option.
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.json b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.json
new file mode 100644
index 00000000..0ebc737b
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test5.test.build.10gen.cc/?ssl=false",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "authSource": "thisDB",
+    "ssl": false
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.yml b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.yml
new file mode 100644
index 00000000..2a922aa2
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-ssl-option.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test5.test.build.10gen.cc/?ssl=false"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    authSource: thisDB
+    ssl: false
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.json b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.json
new file mode 100644
index 00000000..2626ba60
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.json
@@ -0,0 +1,16 @@
+{
+  "uri": "mongodb+srv://test5.test.build.10gen.cc/?authSource=otherDB",
+  "seeds": [
+    "localhost.test.build.10gen.cc:27017"
+  ],
+  "hosts": [
+    "localhost:27017",
+    "localhost:27018",
+    "localhost:27019"
+  ],
+  "options": {
+    "replicaSet": "repl0",
+    "authSource": "otherDB",
+    "ssl": true
+  }
+}
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.yml b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.yml
new file mode 100644
index 00000000..a9015599
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-overridden-uri-option.yml
@@ -0,0 +1,11 @@
+uri: "mongodb+srv://test5.test.build.10gen.cc/?authSource=otherDB"
+seeds:
+    - localhost.test.build.10gen.cc:27017
+hosts:
+    - localhost:27017
+    - localhost:27018
+    - localhost:27019
+options:
+    replicaSet: repl0
+    authSource: otherDB
+    ssl: true
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.json b/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.json
new file mode 100644
index 00000000..0d333a45
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test7.test.build.10gen.cc/",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because \"ssl\" is not an allowed option."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.yml b/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.yml
new file mode 100644
index 00000000..ba3877ee
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/txt-record-with-unallowed-option.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test7.test.build.10gen.cc/"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because "ssl" is not an allowed option.
diff --git a/t/data/initial_dns_seedlist_discovery/uri-with-port.json b/t/data/initial_dns_seedlist_discovery/uri-with-port.json
new file mode 100644
index 00000000..b981e2a1
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/uri-with-port.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test5.test.build.10gen.cc:8123/?replicaSet=repl0",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because the mongodb+srv URI includes a port."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/uri-with-port.yml b/t/data/initial_dns_seedlist_discovery/uri-with-port.yml
new file mode 100644
index 00000000..f1944dcd
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/uri-with-port.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test5.test.build.10gen.cc:8123/?replicaSet=repl0"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because the mongodb+srv URI includes a port.
diff --git a/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.json b/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.json
new file mode 100644
index 00000000..5261a39c
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.json
@@ -0,0 +1,7 @@
+{
+  "uri": "mongodb+srv://test5.test.build.10gen.cc,test6.test.build.10gen.cc/?replicaSet=repl0",
+  "seeds": [],
+  "hosts": [],
+  "error": true,
+  "comment": "Should fail because the mongodb+srv URI includes two host names."
+}
diff --git a/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.yml b/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.yml
new file mode 100644
index 00000000..3b2189d4
--- /dev/null
+++ b/t/data/initial_dns_seedlist_discovery/uri-with-two-hosts.yml
@@ -0,0 +1,5 @@
+uri: "mongodb+srv://test5.test.build.10gen.cc,test6.test.build.10gen.cc/?replicaSet=repl0"
+seeds: []
+hosts: []
+error: true
+comment: Should fail because the mongodb+srv URI includes two host names.

From efa93f1b5f277bde8e6f56e01ec3d13ce2407092 Mon Sep 17 00:00:00 2001
From: Thomas Bloor <tbsliver@shadow.cat>
Date: Mon, 18 Dec 2017 18:17:32 +0000
Subject: [PATCH 3/8] PERL-807 Attempting to get an SSL set working

---
 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t | 57 +++++++++++++++++++++++---
 1 file changed, 52 insertions(+), 5 deletions(-)

diff --git a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
index da24f7cd..1280c71a 100644
--- a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
+++ b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
@@ -17,9 +17,12 @@
 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 Devel::Dwarn;
 
 use lib "t/lib";
 use lib "devel/lib";
@@ -38,25 +41,69 @@ for my $port ( 27017, 27018, 27019 ) {
     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} = {
+    mode     => 'requireSSL',
+    username => $cert_user,
+    servercn => $server_cn,
+    certs    => { map { $_ => $certs{$_} } qw/server ca client/ },
+};
+my $config_path = Path::Tiny->tempfile;
+DumpFile( "$config_path", $config );
+Dwarn $config;
+
+Dwarn "Before orc";
 my $orc =
   MongoDBTest::Orchestrator->new(
-    config_file => "devel/config/replicaset-any-27017.yml" );
+    config_file => "$config_path" );
 $orc->start;
 
+Dwarn "after orc";
+
+sub new_client {
+    my $host = shift;
+    return build_client(
+        host    => $host,
+        dt_type => undef,
+        username => $cert_user,
+        auth_mechanism => 'MONGODB-X509',
+        ssl            => {
+            SSL_cert_file       => $certs{client},
+            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 { MongoDB->connect( $test->{uri} ) }, undef,
+        isnt( exception { new_client( $test->{uri} ) }, undef,
             "invalid uri" );
         return;
     }
 
-    use Devel::Dwarn;
     Dwarn $test;
-    my $mongo = MongoDB->connect( $test->{uri} );
+    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} } };
@@ -84,6 +131,6 @@ while ( my $path = $iterator->() ) {
     last;
 }
 
-
 clear_testdbs;
+
 done_testing;

From 271654b208ec7924e9aaeeee3146ae99b72c7a45 Mon Sep 17 00:00:00 2001
From: David Golden <xdg@xdg.me>
Date: Mon, 18 Dec 2017 21:51:45 -0500
Subject: [PATCH 4/8] minor: fix test orchestration for SSL clusters

---
 devel/lib/MongoDBTest/ReplicaSet.pm     | 20 ++++++------
 devel/lib/MongoDBTest/Role/Server.pm    | 42 ++++++++++++++++---------
 devel/lib/MongoDBTest/Role/ServerSet.pm | 25 +++++++++++++++
 devel/lib/MongoDBTest/ShardedCluster.pm | 32 ++++++++++++++++++-
 4 files changed, 93 insertions(+), 26 deletions(-)

diff --git a/devel/lib/MongoDBTest/ReplicaSet.pm b/devel/lib/MongoDBTest/ReplicaSet.pm
index 90ca1284..5cefffbd 100644
--- a/devel/lib/MongoDBTest/ReplicaSet.pm
+++ b/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"
diff --git a/devel/lib/MongoDBTest/Role/Server.pm b/devel/lib/MongoDBTest/Role/Server.pm
index c22db410..a9325372 100644
--- a/devel/lib/MongoDBTest/Role/Server.pm
+++ b/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;
diff --git a/devel/lib/MongoDBTest/Role/ServerSet.pm b/devel/lib/MongoDBTest/Role/ServerSet.pm
index 01a7fc4d..a805c090 100644
--- a/devel/lib/MongoDBTest/Role/ServerSet.pm
+++ b/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
diff --git a/devel/lib/MongoDBTest/ShardedCluster.pm b/devel/lib/MongoDBTest/ShardedCluster.pm
index b524ee21..ee4023f7 100644
--- a/devel/lib/MongoDBTest/ShardedCluster.pm
+++ b/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;

From da210c06ddf11136b6e56d199d4f7dc78fa4c2c4 Mon Sep 17 00:00:00 2001
From: David Golden <xdg@xdg.me>
Date: Mon, 18 Dec 2017 21:52:02 -0500
Subject: [PATCH 5/8] WIP: turn off SSL auth in PERL-807 test

---
 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
index 1280c71a..20bb0aa9 100644
--- a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
+++ b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
@@ -55,7 +55,6 @@ my %certs = (
 my $config  = LoadFile("devel/config/replicaset-any-27017.yml");
 $config->{ssl_config} = {
     mode     => 'requireSSL',
-    username => $cert_user,
     servercn => $server_cn,
     certs    => { map { $_ => $certs{$_} } qw/server ca client/ },
 };
@@ -76,10 +75,7 @@ sub new_client {
     return build_client(
         host    => $host,
         dt_type => undef,
-        username => $cert_user,
-        auth_mechanism => 'MONGODB-X509',
         ssl            => {
-            SSL_cert_file       => $certs{client},
             SSL_ca_file         => $certs{ca},
             SSL_verifycn_scheme => 'none',
         },

From 009d3f8fb24dc33bb559ebde0eb3a8cf1d3b0db6 Mon Sep 17 00:00:00 2001
From: Thomas Bloor <tbsliver@shadow.cat>
Date: Wed, 20 Dec 2017 14:52:21 +0000
Subject: [PATCH 6/8] PERL-807 Fixed test to pass with all SRV test cases and
 added Net::DNS dependency

---
 Makefile.PL                            |  1 +
 devel/t-dynamic/PERL-807-DNS-SRV-TXT.t | 17 ++++-----
 lib/MongoDB/MongoClient.pm             |  7 +++-
 lib/MongoDB/_URI.pm                    | 53 ++++++++++++++++----------
 4 files changed, 47 insertions(+), 31 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index 27f927f6..9f1e28db 100644
--- a/Makefile.PL
+++ b/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';
diff --git a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
index 20bb0aa9..6b016eab 100644
--- a/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
+++ b/devel/t-dynamic/PERL-807-DNS-SRV-TXT.t
@@ -22,7 +22,7 @@ use Path::Tiny 0.054; # basename with suffix
 use Test::More 0.88;
 use Test::Fatal;
 use Try::Tiny;
-use Devel::Dwarn;
+use Sys::Hostname;
 
 use lib "t/lib";
 use lib "devel/lib";
@@ -54,22 +54,19 @@ my %certs = (
 
 my $config  = LoadFile("devel/config/replicaset-any-27017.yml");
 $config->{ssl_config} = {
-    mode     => 'requireSSL',
+    # 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 );
-Dwarn $config;
 
-Dwarn "Before orc";
 my $orc =
   MongoDBTest::Orchestrator->new(
     config_file => "$config_path" );
 $orc->start;
 
-Dwarn "after orc";
-
 sub new_client {
     my $host = shift;
     return build_client(
@@ -92,7 +89,6 @@ sub run_test {
         return;
     }
 
-    Dwarn $test;
     my $mongo;
     try {
       $mongo = new_client( $test->{uri} );
@@ -107,7 +103,11 @@ sub run_test {
     $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" );
-    Dwarn $mongo->topology_status( refresh => 1 );
+    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");
@@ -124,7 +124,6 @@ while ( my $path = $iterator->() ) {
             run_test( $plan );
         }
     };
-    last;
 }
 
 clear_testdbs;
diff --git a/lib/MongoDB/MongoClient.pm b/lib/MongoDB/MongoClient.pm
index d1ae5d05..46680813 100644
--- a/lib/MongoDB/MongoClient.pm
+++ b/lib/MongoDB/MongoClient.pm
@@ -784,11 +784,16 @@ has ssl => (
 
 sub _build_ssl {
     my ($self) = @_;
-    return $self->__uri_or_else(
+    my $ssl = $self->__uri_or_else(
         u => 'ssl',
         e => 'ssl',
         d => 0,
     );
+    # allow optional arguments to override as long as SSL is already enabled
+    if ( $ssl && exists $self->_deferred->{ssl} ) {
+        return $self->_deferred->{ssl};
+    }
+    return $ssl;
 }
 
 =attr username
diff --git a/lib/MongoDB/_URI.pm b/lib/MongoDB/_URI.pm
index 9b82f0e8..2b17dfe7 100644
--- a/lib/MongoDB/_URI.pm
+++ b/lib/MongoDB/_URI.pm
@@ -212,7 +212,6 @@ sub _parse_srv_uri {
         $result{db_name},  $result{options}
     ) = ( $1, $2, $3, $4, $5 );
 
-    Dwarn \%result;
     if ( defined $result{username} ) {
         MongoDB::Error->throw("URI '$self' cannot have a username if using an SRV connection string");
     }
@@ -233,15 +232,15 @@ sub _parse_srv_uri {
         MongoDB::Error->throw("URI '$self' cannot contain a comma or multiple host names if using an SRV connection string");
     }
 
+    if ( $result{hostids} =~ /:\d+$/ ) {
+        MongoDB::Error->throw("URI '$self' cannot contain port number if using an SRV connection string");
+    }
+
     if ( defined $result{options} ) {
         my $valid = $self->valid_options;
         $result{options} = $self->_parse_options( $valid, \%result );
     }
 
-    # TODO error on invalid domains
-
-    Dwarn \%result;
-
     require Net::DNS;
 
     my $res = Net::DNS::Resolver->new;
@@ -249,29 +248,37 @@ sub _parse_srv_uri {
 
     my @hosts;
     my $options = {};
-
+    my @split_name = split( '\.', $result{hostids} );
+    my $domain_name = join( '.', @split_name[1..$#split_name] );
     if ( $srv_data ) {
         foreach my $rr ( $srv_data->answer ) {
             next unless $rr->type eq 'SRV';
-            # TODO check url is correct?
+            my $target = $rr->target;
+            # search for dot before domain name for a valid hostname - can have sub-subdomain
+            unless ( $target =~ /\.${\$domain_name}$/ ) {
+                MongoDB::Error->throw(
+                    "URI '$self' SRV record returns FQDN '$target'"
+                    . " which does not match domain name '${$domain_name}'"
+                );
+            }
             push @hosts, {
-              target => $rr->target,
+              target => $target,
               port   => $rr->port,
             };
         }
         my $txt_data = $res->query( $result{hostids}, 'TXT' );
-        my @txt_answers;
-        foreach my $rr ( $txt_data->answer ) {
-            next unless $rr->type eq 'TXT';
-            push @txt_answers, $rr;
-        }
-        if ( scalar( @txt_answers ) > 1 ) {
-            MongoDB::Error->throw("URI '$self' returned more than one TXT result");
-        } elsif ( scalar( @txt_answers ) == 1 ) {
-            my @txt_data = $txt_answers[0]->txtdata;
-            my $txt_opt_string = join ( '', @txt_data );
-            Dwarn $txt_opt_string;
-            $options = $self->_parse_options( $self->valid_srv_options, { options => $txt_opt_string }, 1 );
+        if ( defined $txt_data ) {
+            my @txt_answers;
+            foreach my $rr ( $txt_data->answer ) {
+                next unless $rr->type eq 'TXT';
+                push @txt_answers, $rr;
+            }
+            if ( scalar( @txt_answers ) > 1 ) {
+                MongoDB::Error->throw("URI '$self' returned more than one TXT result");
+            } elsif ( scalar( @txt_answers ) == 1 ) {
+                my $txt_opt_string = join ( '', $txt_answers[0]->txtdata );
+                $options = $self->_parse_options( $self->valid_srv_options, { options => $txt_opt_string }, 1 );
+            }
         }
     } else {
         MongoDB::Error->throw("URI '$self' does not return any SRV results");
@@ -284,6 +291,11 @@ sub _parse_srv_uri {
       %{ $result{options} || {} },
     };
 
+    # must force string false instead of boolean
+    if ( ! $options->{ssl} && $options->{ssl} == 0 ) {
+      $options->{ssl} = 'false';
+    }
+
     my $new_uri = sprintf(
         'mongodb://%s/%s%s',
         join( ',', map { sprintf( '%s:%s', $_->{target}, $_->{port} ) } @hosts ),
@@ -291,7 +303,6 @@ sub _parse_srv_uri {
         join( '&', map { sprintf( '%s=%s', $_, $options->{$_} ) } keys %$options ),
     );
 
-    Dwarn $new_uri;
     return $new_uri;
 }
 

From cbaf778edb84ebe611ff27ce1d485699ac62c795 Mon Sep 17 00:00:00 2001
From: Thomas Bloor <tbsliver@shadow.cat>
Date: Thu, 21 Dec 2017 17:07:36 +0000
Subject: [PATCH 7/8] PERL-807 fixes from code review

---
 lib/MongoDB/_URI.pm | 133 ++++++++++++++++++++++++++------------------
 1 file changed, 80 insertions(+), 53 deletions(-)

diff --git a/lib/MongoDB/_URI.pm b/lib/MongoDB/_URI.pm
index 2b17dfe7..d0801169 100644
--- a/lib/MongoDB/_URI.pm
+++ b/lib/MongoDB/_URI.pm
@@ -156,9 +156,8 @@ sub _parse_doc {
     return $set;
 }
 
-use Devel::Dwarn;
 sub _parse_options {
-    my ( $self, $valid, $result, $err_unsupported ) = @_;
+    my ( $self, $valid, $result, $txt_record ) = @_;
 
     my %parsed;
     for my $opt ( split '&', $result->{options} ) {
@@ -168,15 +167,15 @@ sub _parse_options {
         # connection string spec calls for case normalization
         ( my $lc_k = $k ) =~ tr[A-Z][a-z];
         if ( !$valid->{$lc_k} ) {
-            if ( $err_unsupported ) {
-                MongoDB::Error->throw("Unsupported option '$k' in URI $self\n");
+            if ( $txt_record ) {
+                MongoDB::Error->throw("Unsupported option '$k' in URI $self for TXT record $txt_record\n");
             } else {
                 warn "Unsupported option '$k' in URI $self\n";
             }
             next;
         }
         if ( exists $parsed{$lc_k} && !exists $options_with_list_type{$lc_k} ) {
-            warn "Multiple options were found for the same value '$lc_k'\n";
+            warn "Multiple options were found for the same value '$lc_k'. The first occurrence will be used\n";
             next;
         }
         if ( $lc_k eq 'authmechanismproperties' ) {
@@ -200,62 +199,27 @@ sub _parse_options {
     return \%parsed;
 }
 
-sub _parse_srv_uri {
-    my ( $self, $uri ) = @_;
-
-    my %result;
-
-    $uri =~ m{^$uri_re$};
-
-    (
-        $result{username}, $result{password}, $result{hostids},
-        $result{db_name},  $result{options}
-    ) = ( $1, $2, $3, $4, $5 );
+sub _fetch_dns_seedlist {
+    my ( $self, $host_name ) = @_;
 
-    if ( defined $result{username} ) {
-        MongoDB::Error->throw("URI '$self' cannot have a username if using an SRV connection string");
-    }
-
-    if ( defined $result{password} ) {
-        MongoDB::Error->throw("URI '$self' cannot have a password if using an SRV connection string");
-    }
-
-    if ( defined $result{db_name} && length $result{db_name} ) {
-        MongoDB::Error->throw("URI '$self' cannot have a database name if using an SRV connection string");
-    }
-
-    if ( !defined $result{hostids} || !length $result{hostids} ) {
-        MongoDB::Error->throw("URI '$self' cannot be empty if using an SRV connection string");
-    }
-
-    if ( $result{hostids} =~ /,/ ) {
-        MongoDB::Error->throw("URI '$self' cannot contain a comma or multiple host names if using an SRV connection string");
-    }
-
-    if ( $result{hostids} =~ /:\d+$/ ) {
-        MongoDB::Error->throw("URI '$self' cannot contain port number if using an SRV connection string");
-    }
-
-    if ( defined $result{options} ) {
-        my $valid = $self->valid_options;
-        $result{options} = $self->_parse_options( $valid, \%result );
-    }
+    my @split_name = split( '\.', $host_name );
+    MongoDB::Error->throw("URI '$self' must contain domain name and hostname")
+        unless scalar( @split_name ) > 2;
 
     require Net::DNS;
 
     my $res = Net::DNS::Resolver->new;
-    my $srv_data = $res->query( sprintf( '_mongodb._tcp.%s', $result{hostids} ), 'SRV' );
+    my $srv_data = $res->query( sprintf( '_mongodb._tcp.%s', $host_name ), 'SRV' );
 
     my @hosts;
     my $options = {};
-    my @split_name = split( '\.', $result{hostids} );
     my $domain_name = join( '.', @split_name[1..$#split_name] );
     if ( $srv_data ) {
         foreach my $rr ( $srv_data->answer ) {
             next unless $rr->type eq 'SRV';
             my $target = $rr->target;
             # search for dot before domain name for a valid hostname - can have sub-subdomain
-            unless ( $target =~ /\.${\$domain_name}$/ ) {
+            unless ( $target =~ /\.\Q$domain_name\E$/ ) {
                 MongoDB::Error->throw(
                     "URI '$self' SRV record returns FQDN '$target'"
                     . " which does not match domain name '${$domain_name}'"
@@ -266,7 +230,7 @@ sub _parse_srv_uri {
               port   => $rr->port,
             };
         }
-        my $txt_data = $res->query( $result{hostids}, 'TXT' );
+        my $txt_data = $res->query( $host_name, 'TXT' );
         if ( defined $txt_data ) {
             my @txt_answers;
             foreach my $rr ( $txt_data->answer ) {
@@ -277,13 +241,58 @@ sub _parse_srv_uri {
                 MongoDB::Error->throw("URI '$self' returned more than one TXT result");
             } elsif ( scalar( @txt_answers ) == 1 ) {
                 my $txt_opt_string = join ( '', $txt_answers[0]->txtdata );
-                $options = $self->_parse_options( $self->valid_srv_options, { options => $txt_opt_string }, 1 );
+                $options = $self->_parse_options( $self->valid_srv_options, { options => $txt_opt_string }, $txt_opt_string );
             }
         }
     } else {
         MongoDB::Error->throw("URI '$self' does not return any SRV results");
     }
 
+    return ( \@hosts, $options );
+}
+
+sub _parse_srv_uri {
+    my ( $self, $uri ) = @_;
+
+    my %result;
+
+    $uri =~ m{^$uri_re$};
+
+    (
+        $result{username}, $result{password}, $result{hostids},
+        $result{db_name},  $result{options}
+    ) = ( $1, $2, $3, $4, $5 );
+
+    if ( defined $result{username} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a username if using an SRV connection string");
+    }
+
+    if ( defined $result{password} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a password if using an SRV connection string");
+    }
+
+    if ( defined $result{db_name} && length $result{db_name} ) {
+        MongoDB::Error->throw("URI '$self' cannot have a database name if using an SRV connection string");
+    }
+
+    if ( !defined $result{hostids} || !length $result{hostids} ) {
+        MongoDB::Error->throw("URI '$self' cannot be empty if using an SRV connection string");
+    }
+
+    if ( $result{hostids} =~ /,/ ) {
+        MongoDB::Error->throw("URI '$self' cannot contain a comma or multiple host names if using an SRV connection string");
+    }
+
+    if ( $result{hostids} =~ /:\d+$/ ) {
+        MongoDB::Error->throw("URI '$self' cannot contain port number if using an SRV connection string");
+    }
+
+    if ( defined $result{options} ) {
+        $result{options} = $self->_parse_options( $self->valid_options, \%result );
+    }
+
+    my ( $hosts, $options ) = $self->_fetch_dns_seedlist( $result{hostids} );
+
     # Default to SSL on unless specified in conn string options
     $options = {
       ssl => 'true',
@@ -291,14 +300,14 @@ sub _parse_srv_uri {
       %{ $result{options} || {} },
     };
 
-    # must force string false instead of boolean
+    # URI requires string based booleans for re-constructing the URI
     if ( ! $options->{ssl} && $options->{ssl} == 0 ) {
       $options->{ssl} = 'false';
     }
 
     my $new_uri = sprintf(
         'mongodb://%s/%s%s',
-        join( ',', map { sprintf( '%s:%s', $_->{target}, $_->{port} ) } @hosts ),
+        join( ',', map { sprintf( '%s:%s', $_->{target}, $_->{port} ) } @$hosts ),
         scalar( keys %$options ) ? '?' : '',
         join( '&', map { sprintf( '%s=%s', $_, $options->{$_} ) } keys %$options ),
     );
@@ -372,8 +381,7 @@ sub BUILD {
     }
 
     if ( defined $result{options} ) {
-        my $valid = $self->valid_options;
-        $result{options} = $self->_parse_options( $valid, \%result );
+        $result{options} = $self->_parse_options( $self->valid_options, \%result );
     }
 
     for my $attr (qw/username password db_name options hostids/) {
@@ -393,6 +401,25 @@ sub __str_to_bool {
     MongoDB::UsageError->throw("expected boolean string 'true' or 'false' for key '$k' but instead received '$str'");
 }
 
+# uri_escape borrowed from HTTP::Tiny 0.070
+my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
+$escapes{' '}="+";
+my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
+
+sub __uri_escape {
+    my ($str) = @_;
+    if ( $] ge '5.008' ) {
+        utf8::encode($str);
+    }
+    else {
+        $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
+            if ( length $str == do { use bytes; length $str } );
+        $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
+    }
+    $str =~ s/($unsafe_char)/$escapes{$1}/ge;
+    return $str;
+}
+
 # redact user credentials when stringifying
 use overload
     '""' => sub {

From 0a3989cb37d04b7b72083130ca4cfb7eb352fb17 Mon Sep 17 00:00:00 2001
From: Thomas Bloor <tbsliver@shadow.cat>
Date: Thu, 21 Dec 2017 17:20:19 +0000
Subject: [PATCH 8/8] PERL-807 unescape hostids on SRV and uri_escape options

---
 lib/MongoDB/_URI.pm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/lib/MongoDB/_URI.pm b/lib/MongoDB/_URI.pm
index d0801169..bb251cde 100644
--- a/lib/MongoDB/_URI.pm
+++ b/lib/MongoDB/_URI.pm
@@ -275,6 +275,8 @@ sub _parse_srv_uri {
         MongoDB::Error->throw("URI '$self' cannot have a database name if using an SRV connection string");
     }
 
+    $result{hostids} = lc _unescape_all( $result{hostids} );
+
     if ( !defined $result{hostids} || !length $result{hostids} ) {
         MongoDB::Error->throw("URI '$self' cannot be empty if using an SRV connection string");
     }
@@ -309,7 +311,7 @@ sub _parse_srv_uri {
         'mongodb://%s/%s%s',
         join( ',', map { sprintf( '%s:%s', $_->{target}, $_->{port} ) } @$hosts ),
         scalar( keys %$options ) ? '?' : '',
-        join( '&', map { sprintf( '%s=%s', $_, $options->{$_} ) } keys %$options ),
+        join( '&', map { sprintf( '%s=%s', $_, __uri_escape( $options->{$_} ) ) } keys %$options ),
     );
 
     return $new_uri;