Commit 964b8d11 authored by Kevin Atkinson's avatar Kevin Atkinson

Add patch to modify Mysql.pm to allow setting the "InactiveDestroy" in
the underlying DB handle.  Also avoid disconnecting the file handle
explistly on DESTROY as that will be taken care of in the DESTROY
method for the the DB handle.

Override perl version of fork() to set InactiveDestroy in all open
database handles in the child so that it won't send a disconnect when
the handle is destroyed as this will also close the database handle
for the parent.  It will also call tblog_new_child_process in the
child process to properly inform tblog of the new process. This will
be a NoOp if the libtblog module is not loaded.
parent a55eba7f
......@@ -10,6 +10,8 @@
# A library of useful DB stuff. Mostly things that get done a lot.
# Saves typing.
#
# NOTE: Overrides perl's builtin fork()
#
# XXX: The notion of "uid" is a tad confused. A unix uid is a number,
# while in the DB a user uid is a string (equiv to unix login).
# Needs to be cleaned up.
......@@ -240,6 +242,7 @@ use POSIX qw(strftime);
require Node;
require NodeType;
require Mysql;
use subs qw(fork);
use vars qw($DBQUERY_MAXTRIES $DBCONN_MAXTRIES
$DBCONN_EXITONERR $DBQUERY_RECONNECT
@EXPORT_OK @virtualTables @physicalTables);
......@@ -378,6 +381,30 @@ sub NewTBDBHandle() {
return $dbnum;
}
#
# Special version of fork to
# 1) Set InactiveDestroy in the child process so that it won't send a
# disconnect when the handle is destroyed as this will also
# close the database handle for the parent
# 2) Call tblog_new_child_process in the child process to properly
# inform tblog of the new process. NOTE: This will be a NoOp
# if the libtblog module is not loaded.
#
sub fork() {
my $pid = CORE::fork();
return $pid unless defined $pid;
if ($pid == 0) {
# We are the child
for (my $i = 0; $i < @DB; $i++) {
$DB[$i]->setInactiveDestroy(1) if defined $DB[$i];
}
tblog_new_child_process();
}
return $pid;
}
*CORE::GLOBAL::fork = \&fork;
#
# Record last DB error string.
#
......
......@@ -103,6 +103,7 @@ my $CRACKLIB_DICT = "/usr/local/lib/pw_dict.pwd";
my $STL_PATCH = "$TOP_SRCDIR/patches/g++.patch";
my $M2CRYPTO_PATCH = "$TOP_SRCDIR/patches/m2crypto.patch";
my $MYSQL_PM_PATCH = "$TOP_SRCDIR/patches/Mysql.pm.patch";
my $PHP4_PATCH = "$TOP_SRCDIR/patches/php4-Makefile.patch";
my $INIT_PRIVKEY = "$TOP_SRCDIR/install/identity";
......@@ -460,6 +461,27 @@ Phase "patches", "Applying patches", sub {
}
ExecQuietFatal("$PATCH -f -l -p0 -i $patchfile");
};
Phase "Mysql.pm.patch", "Patching Mysql.pm", sub {
my $patchfile = $MYSQL_PM_PATCH;
my $patchfile = `realpath $patchfile`;
chomp $patchfile;
my $dir;
foreach $prefix (@INC) {
if (-e "$prefix/Mysql.pm") {
$dir = $prefix;
last;
}
}
if (!defined($dir)) {
PhaseFail("Unable to find Mysql.pm");
}
if (!ExecQuiet("$PATCH -d $dir -C -f -l -R -i $patchfile")) {
PhaseSkip("$patchfile already applied");
}
ExecQuietFatal("$PATCH -d $dir -f -l -i $patchfile");
};
};
Phase "cracklib", "Installing cracklib", sub {
......
--- Mysql.pm.orig Sun Aug 27 01:31:42 2006
+++ Mysql.pm Mon Aug 28 04:24:06 2006
@@ -80,15 +80,36 @@
$self;
}
-sub DESTROY {
- my $self = shift;
- my $dbh = $self->{'dbh'};
- if ($dbh) {
- local $SIG{'__WARN__'} = sub {};
- $dbh->disconnect();
+#
+# setInactiveDestroy and getInactiveDestroy added by
+# kevina@flux.utah.edu. See InactiveDestroy attribute in DBI(3).
+#
+
+sub setInactiveDestroy($) {
+ my ($self, $newvalue) = @_;
+ if ($self->{'dbh'}) {
+ my $oldvalue = $self->{'dbh'}->{'InactiveDestroy'};
+ $self->{'dbh'}->{'InactiveDestroy'} = $newvalue;
+ return $oldvalue;
+ } else {
+ return undef;
+ }
+}
+
+sub getInactiveDestroy() {
+ my ($self) = @_;
+ if ($self->{'dbh'}) {
+ return $self->{'dbh'}->{'InactiveDestroy'};
+ } else {
+ return undef;
}
}
+sub DESTROY {
+ # NoOp: The database handle will automatically be closed
+ # by the DBI driver. -- kevina@flux.utah.edu
+}
+
sub selectdb ($$) {
my($self, $db) = @_;
my $dsn = "DBI:mysql:database=$db:host=" . $self->{'host'};
@@ -98,10 +119,6 @@
$self->{'errno'} = $DBI::err;
undef;
} else {
- if ($self->{'dbh'}) {
- local $SIG{'__WARN__'} = sub {};
- $self->{'dbh'}->disconnect();
- }
$self->{'dbh'} = $dbh;
$self->{'db'} = $db;
$self;
......@@ -208,7 +208,8 @@ use Exporter;
tbdie tbreport tblog_set_info tblog_set_default_cause
tblog_sub_process tblog_find_error tblog_email_error
tblog_start_capture tblog_stop_capture
tblog_new_process tblog_init_process tblog_exit
tblog_new_process tblog_new_child_process
tblog_init_process tblog_exit
tblog_session tblog_lookup_error tblog_format_error
tblog_set_attempt tblog_inc_attempt tblog_get_attempt
tblog_set_cleanup tblog_get_cleanup
......@@ -419,19 +420,34 @@ sub tblog_new_process(@) {
#
# NOTE: Everything is currently stored in the %ENV hash.
#
sub tblog_init_process(@) {
sub tblog_init_process_real(@) {
my ($script, @argv) = @_;
local $DBQUERY_MAXTRIES = 3;
# Get script name
if (defined $script) {
$ENV{TBLOG_SCRIPTNAME} = $script;
$ENV{TBLOG_BASE_SCRIPTNAME} = $script unless defined $ENV{TBLOG_BASE_SCRIPTNAME};
# Get script name
$ENV{TBLOG_SCRIPTNAME} = $script;
$ENV{TBLOG_BASE_SCRIPTNAME} = $script unless defined $ENV{TBLOG_BASE_SCRIPTNAME};
# Get script number
$ENV{TBLOG_SCRIPTNUM} = script_name_to_num($ENV{TBLOG_SCRIPTNAME});
# Reset the child field
delete $ENV{TBLOG_CHILD};
} else {
# Get script number
# We are a child process after a fork
$ENV{TBLOG_SCRIPTNUM} = script_name_to_num($ENV{TBLOG_SCRIPTNAME});
$ENV{TBLOG_CHILD} = 1;
@argv = ('...');
}
# ...
if (defined $ENV{'TBLOG_SESSION'}) {
......@@ -464,6 +480,10 @@ sub tblog_init_process(@) {
}
}
{
local $^W = 0;
*tblog_init_process = \&tblog_init_process_real;
}
=item tblog_sub_process NAME, ARGV
......@@ -614,11 +634,16 @@ sub tblog_exit() {
# informative_scriptname()
#
sub informative_scriptname() {
my $name;
if ($ENV{TBLOG_BASE_SCRIPTNAME} eq $REAL_SCRIPTNAME) {
return $ENV{TBLOG_SCRIPTNAME};
$name = $ENV{TBLOG_SCRIPTNAME};
} else {
return "$ENV{TBLOG_SCRIPTNAME} (but really $REAL_SCRIPTNAME)";
$name = "$ENV{TBLOG_SCRIPTNAME} (but really $REAL_SCRIPTNAME)";
}
if ($ENV{TBLOG_CHILD}) {
$name = "child of $name";
}
return $name;
}
......
......@@ -23,8 +23,7 @@ use Exporter;
@ISA = "Exporter";
@EXPORT = qw (tblog tberror tberr tbwarn tbwarning tbnotice tbinfo tbdebug
tbdie
tblog_session
tbdie tblog_new_child_process tblog_session
TBLOG_EMERG TBLOG_ALERT TBLOG_CRIT TBLOG_ERR
TBLOG_WARNING TBLOG_NOTICE TBLOG_INFO TBLOG_DEBUG
SEV_DEBUG SEV_NOTICE SEV_WARNING SEV_SECONDARY
......@@ -128,6 +127,17 @@ sub tblog_session() {
return $ENV{TBLOG_SESSION};
}
#
# Dummy tblog_init_process, does nothing in this module
# Once the real "libtblog.pm" is used than this will be replaced
# with the real function
#
sub tblog_init_process_dummy( @ ) {
return 1;
}
*tblog_init_process = \&tblog_init_process_dummy;
#
# Dummy dblog, does nothing in this module
# Once the real "libtblog.pm" is used than this will be replaced
......@@ -138,6 +148,14 @@ sub dblog_dummy( $$@ ) {
}
*dblog = \&dblog_dummy;
#
# Enter a new child process, which should be called after a fork
#
sub tblog_new_child_process() {
tblog_init_process(undef);
}
#
# tblog(priority, mesg, ...)
# tblog(priority, {parm=>value,...}, mesg, ...)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment