Fix missing handling of on_(dis)connect* failures

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 ed95a74..ac61b35 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,10 @@ Revision history for DBIx::Class
           ->req_list_for([qw( rdbms_oracle icdt )]) bringing in the Oracle
           specific DateTime::Format dependencies
 
+    * Fixes
+        - Ensure failing on_connect* / on_disconnect* are dealt with properly,
+          notably on_connect* failures now properly abort the entire connect
+
     * Misc
         - Skip tests in a way more intelligent and speedy manner when optional
           dependencies are missing

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 25a4513..abd9e9d 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1115,6 +1115,10 @@ sub _server_info {
   # this confuses CXSA: https://rt.cpan.org/Ticket/Display.html?id=103296
   $self->_dbh_details->{info} || do {
 
+    # this guarantees that problematic conninfo won't be hidden
+    # by the try{} below
+    $self->ensure_connected;
+
     my $info = {};
 
     my $server_version = try {
@@ -1373,6 +1377,7 @@ sub _warn_undetermined_driver {
 sub _do_connection_actions {
   my ($self, $method_prefix, $call, @args) = @_;
 
+  try {
     if (not ref($call)) {
       my $method = $method_prefix . $call;
       $self->$method(@args);
@@ -1391,6 +1396,19 @@ sub _do_connection_actions {
     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..e01da70 100644 (file)
--- a/t/storage/error.t
+++ b/t/storage/error.t
@@ -8,6 +8,61 @@ 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 $ENV{DBICTEST_VIA_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 $ENV{DBICTEST_VIA_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 {