Fix missing handling of on_(dis)connect* failures

( cherry-pick of b81538923 )

Time for a short story (see last paragraph for TL;DR): Some hours ago an
innocent question was asked in the #dbix-class channel, apparently
related to a mysterious failure to determine the RDBMS version. Before I
was able to properly investigate the problem, someone else piped up with
"Oh I've seen this before, and I worked around it". That was of course
without telling anyone else </headdesk>

After a little back and forth it became apparent that if the on_connect
settings could not be executed for whatever reason, the result may be an
implicitly failed connection attempt which is *entirely undetected* as
it leaves the original $dbh in place with some or all of the on_connect
instructions not having executed as expected.

To reiterate: if one manages to:
 * supply a malformed on_connect*
and then
 * call as the first order of business some codepath that can mask away
   the connection failure (say ->deploy under sqlite)
then the result is a $schema with a proper $dbh in the storage instance,
but *without* some (or all) of the on_connect instructions having been
executed. As a bonus the actual call to get e.g. the RDBMS metadata (like
version etc) will have failed completely silently as well. Arguably a
rather problematic bug.

The above and by extension an issue with silent on_disconnect* failures
are bith fixed by this commit. This was possible *only* because the
second person came into the channel and reported it, instead of silently
fixing things and moving on to whatever they were doing.

Moreover while preparing the (relatively modest) patch to fix this issue,
a small refactor revealed a pretty serious bug in the XS accessor provider
Class::XSAccessor: https://rt.cpan.org/Ticket/Display.html?id=103296
Yes, it took about 3 hours to diagnose this and hunt down an isolated
failcase, but the bug severety (and its elegance) are totally worth it.

Moral of the story: *PLEASE* report issues upstream. Even if you figured
out a quick workaround, the devs still need to know about the problem you
did encounter in the first place. Bugs that nobody knows about can *NOT*
be fixed, and our software commons can not improve. So *PLEASE* speak up.

diff --git a/Changes b/Changes
index fbb0daa..b6c3296 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,8 @@ Revision history for DBIx::Class
     * Fixes
         - Another relatively invasive set of ::FilterColumn changes, covering
           potential data loss (RT#111567). Please run your regression tests!
+        - Ensure failing on_connect* / on_disconnect* are dealt with properly,
+          notably on_connect* failures now properly abort the entire connect
         - Fix use of ::Schema::Versioned combined with a user-supplied
           $dbh->{HandleError} (GH#101)
         - Fix parsing of DSNs containing driver arguments (GH#99)

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 8722299..f9be97b 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1114,6 +1114,9 @@ sub _server_info {
   unless ($info = $self->_dbh_details->{info}) {
 
     $info = {};
+    # this guarantees that problematic conninfo won't be hidden
+    # by the try{} below
+    $self->ensure_connected;
 
     my $server_version = try {
       $self->_get_server_version
@@ -1380,24 +1383,40 @@ sub _warn_undetermined_driver {
 }
 
 sub _do_connection_actions {
-  my $self          = shift;
-  my $method_prefix = shift;
-  my $call          = shift;
-
-  if (not ref($call)) {
-    my $method = $method_prefix . $call;
-    $self->$method(@_);
-  } elsif (ref($call) eq 'CODE') {
-    $self->$call(@_);
-  } elsif (ref($call) eq 'ARRAY') {
-    if (ref($call->[0]) ne 'ARRAY') {
-      $self->_do_connection_actions($method_prefix, $_) for @$call;
-    } else {
-      $self->_do_connection_actions($method_prefix, @$_) for @$call;
+  my ($self, $method_prefix, $call, @args) = @_;
+
+  try {
+    if (not ref($call)) {
+      my $method = $method_prefix . $call;
+      $self->$method(@args);
+    }
+    elsif (ref($call) eq 'CODE') {
+      $self->$call(@args);
+    }
+    elsif (ref($call) eq 'ARRAY') {
+      if (ref($call->[0]) ne 'ARRAY') {
+        $self->_do_connection_actions($method_prefix, $_) for @$call;
+      }
+      else {
+        $self->_do_connection_actions($method_prefix, @$_) for @$call;
+      }
+    }
+    else {
+      $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
     }
-  } else {
-    $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
   }
+  catch {
+    if ( $method_prefix =~ /^connect/ ) {
+      # this is an on_connect cycle - we can't just throw while leaving
+      # a handle in an undefined state in our storage object
+      # kill it with fire and rethrow
+      $self->_dbh(undef);
+      $self->throw_exception( $_[0] );
+    }
+    else {
+      carp "Disconnect action failed: $_[0]";
+    }
+  };
 
   return $self;
 }

diff --git a/t/storage/error.t b/t/storage/error.t
index 6c9b15c..f9b63f9 100644 (file)
--- a/t/storage/error.t
+++ b/t/storage/error.t
@@ -8,6 +8,63 @@ use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
 
+for my $conn_args (
+  [ on_connect_do   => "_NOPE_" ],
+  [ on_connect_call => sub { shift->_dbh->do("_NOPE_") } ],
+  [ on_connect_call => "_NOPE_" ],
+) {
+  for my $method (qw( ensure_connected _server_info _get_server_version _get_dbh )) {
+
+    my $s = DBICTest->init_schema(
+      no_deploy => 1,
+      on_disconnect_call => sub { fail 'Disconnector should not be invoked' },
+      @$conn_args
+    );
+
+    my $storage = $s->storage;
+    $storage = $storage->master
+      if $storage->isa('DBIx::Class::Storage::DBI::Replicated');
+
+    ok( ! $storage->connected, 'Starting unconnected' );
+
+    my $desc = "calling $method with broken on_connect action @{[ explain $conn_args ]}";
+
+    throws_ok { $storage->$method }
+      qr/ _NOPE_ \b/x,
+      "Throwing correctly when $desc";
+
+    ok( ! $storage->connected, "Still not connected after $desc" );
+
+    # this checks that the on_disconect_call FAIL won't trigger
+    $storage->disconnect;
+  }
+}
+
+for my $conn_args (
+  [ on_disconnect_do   => "_NOPE_" ],
+  [ on_disconnect_call => sub { shift->_dbh->do("_NOPE_") } ],
+  [ on_disconnect_call => "_NOPE_" ],
+) {
+  my $s = DBICTest->init_schema( no_deploy => 1, @$conn_args );
+
+  my $storage = $s->storage;
+  $storage = $storage->master
+    if $storage->isa('DBIx::Class::Storage::DBI::Replicated');
+
+  my $desc = "broken on_disconnect action @{[ explain $conn_args ]}";
+
+  # connect + ping
+  my $dbh = $storage->dbh;
+
+  ok ($dbh->FETCH('Active'), 'Freshly connected DBI handle is healthy');
+
+  warnings_exist { eval { $storage->disconnect } } [
+    qr/\QDisconnect action failed\E .+ _NOPE_ \b/x
+  ], "Found warning of failed $desc";
+
+  ok (! $dbh->FETCH('Active'), "Actual DBI disconnect was not prevented by $desc" );
+}
+
 my $schema = DBICTest->init_schema;
 
 warnings_are ( sub {