Re: strange bug with DBI, Sybase, and mod_perl

[Jonathan Swartz]

Yup, that seems to be correct. Here it is reproduced without mod_perl:

   use IO::String;
   use DBI;

   sub handler {
       my $dbh = DBI->connect( "DBI:mysql:$database", $user, $pass,  
{ RaiseError => 1 } );
       system(qq{perl -e 'print "abcd"'});
       eval { $dbh->do("select 1") };
       print "dbh - " . ( $@ ? "error: $@" : "ok" ) . "\n";
   }

   my $old_stdout = select(my $str_fh = IO::String->new(my $str));
   close($old_stdout);
   handler();
   print STDERR "output:\n$str\n";

outputs

   DBD::mysql::db do failed: Lost connection to MySQL server during  
query at ./iostring.pl line 14.
   output:
   dbh - error: DBD::mysql::db do failed: Lost connection to MySQL  
server during query at ./iostring.pl line 14.

So, is this a bug in DBI, or in the code that closes STDOUT (I'm  
assuming that's mod_perl in my original example)?

Jon

On Jan 7, 2010, at 2:57 PM, Martin J. Evans wrote:

Jonathan Swartz wrote:
Something in which code is closing STDOUT? I know that mod_perl  
redirects STDOUT to $r->print...

Incidentally the code to reprodce for mysql is even easier - just  
need one connection. This will do it:

  use DBI;
  sub handler {
      my $dbh = DBI->connect( "DBI:mysql:$database", $user, $pass,  
{ RaiseError => 1 } );
      system(qq{perl -e 'print "abcd"'});
      eval { $dbh->do("select 1") };
      print "dbh - " . ( $@ ? "error: $@" : "ok" ) . "\n";
      return 0;
  }

And as a bonus mystery, if you only print two characters, the  
request hangs. :)

Jon

This latter fact backs up Tim's conclusion (that is that FD 2 is now  
connected to sybase) even more since the sybase server is probably  
waiting to read more than 2 characters/bytes and so is stuck in a  
loop waiting for more to be sent from the client end.

Martin
On Jan 7, 2010, at 2:03 PM, Tim Bunce wrote:

Ah. I think something in the code is closing STDOUT (fd 1) before  
the
handler() is called. The socket that the driver then creates to  
connect
to the server will get fd 2, aka STDOUT, and thus be inherited by  
the
child. Or something like that.

Tim.

On Thu, Jan 07, 2010 at 10:03:06AM -0800, Jonathan Swartz wrote:
Ok, take sendmail out of the equation. The bug will occur iff the
program sends output to STDOUT (which sendmail was doing because of
a warning).

Here's a slightly simplified version.

 our ($dbh1, $dbh2);

 sub dbconnect {
     return DBI->connect( 'DBI:Sybase:...', '...', '...', {
RaiseError => 1 } );
 }

 sub testdb {
     my ( $name, $dbh ) = @_;
     eval { $dbh->do("select 1") };
     print "$name - " . ($@ ? "error: $@" : "ok") . "\n";
 }

 sub handler {
     my ($r) = @_;

     # connect.pl contains one line: BEGIN { $Handler::dbh1 =
Handler::dbconnect() }
     do "/home/jswartz/projects/unchained-transaction/connect.pl";
     $dbh2 = dbconnect();
     system(qq{perl -e 'print "hi"'});
     testdb("dbh1", $dbh1);
     testdb("dbh2", $dbh2);

     return 0;
 }

This outputs

 dbh1 - ok
 dbh2 - error: DBD::Sybase::db do failed: OpenClient message:
LAYER = (5) ORIGIN = (3) SEVERITY = (5) NUMBER = (6)
 Server SANDBOX5, database
 Message String: ct_results(): network packet layer: internal net
library error: Net-Library operation terminated due to disco\
 nnect
 OpenClient message: LAYER = (1) ORIGIN = (1) SEVERITY = (1)
NUMBER = (50)
 Server SANDBOX5, database
 Message String: ct_cmd_drop(): user api layer: external error:
The connection has been marked dead.

However, if I replace the system with

 system(qq{perl -e ''});
or
system(qq{perl -e 'print "hi"' > /dev/null});

then it outputs

dbh1 - ok
dbh2 - ok

On Jan 7, 2010, at 2:20 AM, Tim Bunce wrote:

On Wed, Jan 06, 2010 at 04:08:17PM -0800, Jonathan Swartz wrote:
Thanks for your help...this bug has me feeling very isolated...

Just about everything here is necessary to generate the bug. In
particular, I cannot generate the bug...
* If I move the code from connect.pl into the handler, even  
as a
string eval
* If I remove the "BEGIN" from connect.pl
* If I replace sendmail with another program

That's the most interesting one to me. Try replacing it with a  
perl
script that reports what open file descriptors have been  
inherited.

Ok. What's the easiest way to do that? :) Sorry, probably dumb
question, but never did this before and scanning perlipc and
perlopentut and google didn't yield anything obvious.

I had to rummage around a bit, but this seems to work:

$ perl -e 'open(FH, ">&=$_") and printf "$_\n" for 0..100'
0
1
2

$ perl -e 'open(FH, ">&=$_") and printf "$_\n" for 0..100' 42<&1
0
1
2
42

(Using >&= or <&= doesn't seem to matter for this simple case.)

Tim.