PERL-1118 - Improve URI stringify sanitization

lib/MongoDB/_URI.pm

@@ -655,7 +655,7 @@ sub __userinfo_invalid_chars {
 # redact user credentials when stringifying
 use overload
     '""' => sub {
-        (my $s = $_[0]->uri) =~ s{^(\w+)://[^/]+\@}{$1://[**REDACTED**]\@};
+        (my $s = $_[0]->uri) =~ s{^([^:]+)://[^/]+\@}{$1://[**REDACTED**]\@};
         return $s
     },
     'fallback' => 1;

t/unit/uri.t

@@ -279,4 +279,21 @@ subtest "auth credentials" => sub {
     );
 };
 
+subtest "stringification" => sub {
+    # For srv uri parsing and tests, see uri_srv.t
+    my $uri;
+
+    $uri = new_ok( $class, [ uri => 'mongodb://fred:foobar@localhost' ] );
+    is( "$uri", 'mongodb://[**REDACTED**]@localhost', "stringify correct" );
+
+    $uri = new_ok( $class, [ uri => 'mongodb://:@localhost' ] );
+    is( "$uri", 'mongodb://[**REDACTED**]@localhost', "stringify correct" );
+
+    $uri = new_ok( $class, [ uri => 'mongodb://@localhost' ] );
+    is( "$uri", 'mongodb://@localhost', "stringify correct" );
+
+    $uri = new_ok( $class, [ uri => 'mongodb://localhost' ] );
+    is( "$uri", 'mongodb://localhost', "stringify correct" );
+};
+
 done_testing;

t/unit/uri_srv.t

@@ -90,7 +90,23 @@ subtest "boolean params unchanged" => sub {
         is $sslVal, 'true', 'SSL true';
 
         is $expires, 1, 'expires as expected';
-    }
+    };
+};
+
+subtest "stringification" => sub {
+    my $uri = new_ok( $class, [
+        uri                   => 'mongodb+srv://testpass@testmongo.example.com',
+        _test_seedlist_return => [
+            [{ target => 'localhost', port => 27017 }],
+            {
+                retryWrites => 'true',
+                retryReads  => 'false',
+            },
+            0
+        ]
+    ]);
+
+    is "$uri", 'mongodb+srv://[**REDACTED**]@testmongo.example.com', 'Stringification for SRV urls correct';
 };
 
 done_testing;