This code is in an END { ... } block - I don't see how that indicates a failures.
Please try to produce a short example script that exhibits that behaviour (and describe what you mean by "fail": does it throw an exception? or terminates the script?).
BTW did all DBI tests pass (while installing)? same for the DBD::mysql module? | [reply] [d/l] |
OK, that may not be the problem then. I'm kind of guessing here because at one point the code forks and I don't know how to effectively debug it. Here's what is happening, though:
MailScanner loads the custom perl module and calls InitMailWatchLogging which is as follows:
sub InitMailWatchLogging {
my $pid = fork();
if ($pid) {
# MailScanner child process
waitpid $pid, 0;
MailScanner::Log::InfoLog("Started SQL Logging child");
} else {
# New process
# Detach from parent, make connections, and listen for requests
POSIX::setsid();
if (!fork()) {
$SIG{HUP} = $SIG{INT} = $SIG{PIPE} = $SIG{TERM} = $SIG{ALRM} = \&ExitLogging;
alarm $timeout;
$0 = "MailWatch SQL";
InitConnection();
ListenForMessages();
}
exit;
}
}
sub InitConnection {
# Set up TCP/IP socket. We will start one server per MailScanner
# child, but only one child will actually be able to get the socket.
# The rest will die silently. When one of the MailScanner children
# tries to log a message and fails to connect, it will start a new
# server.
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname("tcp"));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
my $addr = sockaddr_in($server_port, $loop);
bind(SERVER, $addr) or exit;
listen(SERVER, SOMAXCONN) or exit;
# Our reason for existence - the persistent connection to the database
$dbh = DBI->connect("DBI:mysql:database=$db_name;host=$db_host", $db_user, $db_pass, {PrintError => 0});
if (!$dbh) {
MailScanner::Log::WarnLog("Unable to initialise database connection: %s", $DBI::errstr);
}
$sth = $dbh->prepare() or
MailScanner::Log::WarnLog($DBI::errstr);
}
sub ListenForMessages {
my $message;
# Wait for messages
while (my $cli = accept(CLIENT, SERVER)) {
my($port, $packed_ip) = sockaddr_in($cli);
my $dotted_quad = inet_ntoa($packed_ip);
# reset emergency timeout - if we haven"t heard anything in $timeout
# seconds, there is probably something wrong, so we should clean up
# and let another process try.
alarm $timeout;
# Make sure we"re only receiving local connections
if ($dotted_quad ne "127.0.0.1") {
close CLIENT;
next;
}
my @in;
while (<CLIENT>) {
# End of normal logging message
last if /^END$/;
# MailScanner child telling us to shut down
ExitLogging if /^EXIT$/;
chop;
push @in, $_;
}
my $data = join "", @in;
my $tmp = unpack("u", $data);
$message = thaw $tmp;
next unless defined $$message{id};
# Check to make sure DB connection is still valid
#InitConnection unless $dbh->ping;
# Log message
$sth->execute()
if (!$sth) {
MailScanner::Log::WarnLog("$$message{id}: MailWatch SQL Cannot insert row: %s", $sth->errstr);
} else {
MailScanner::Log::InfoLog("$$message{id}: Logged to MailWatch SQL");
}
# Unset
$message = undef;
}
}
I omitted most of the $sth->execute statement because it's just a bunch of variables. Whenever MailScanner scans a message, it calls the function MailWatchLogging. Most of that function is just manipulating variables, but it also tries to write to the server that was started in the code above with this:
while (1) {
socket(TO_SERVER, PF_INET, SOCK_STREAM, getprotobyname("tcp"));
my $addr = sockaddr_in($server_port, $loop);
connect(TO_SERVER, $addr) and last;
# Failed to connect - kick off new child, wait, and try again
InitMailWatchLogging();
sleep 5;
}
Now, the problem I'm seeing is that the fork'd part of the program keeps starting over and over until all the resources on the server are exhausted and I have to restart it. No error is reported in the syslog except for the message "Started SQL Logging child", which you can see is called in InitMailWatchLogging. The number of processes is much greater than the number of emails being scanned, so I believe that the entire problem exists in InitMailWatchLogging, but as previously stated, I don't know how to trace a fork. The first error I mentioned is the only one that I've been able to see, so I had hoped that it had something to do with the original problem. | [reply] |
the problem I'm seeing is that the fork'd part of the program keeps starting over and over
Obviously, you're starting more children than are terminating.
So, in order to debug the issue, I would write a little my_exit() routine,
which you then call everywhere you're now calling the exit builtin.
The my_exit() routine would log somewhere which process died, and then exit.
In its most simple form something like
sub my_exit {
my $from_where = shift;
if (open my $log, ">>", "/tmp/mailscanner-debug.log") {
print $log "$$ exited: $from_where\n";
close $log;
}
exit;
}
so you can verify that the processes are actually terminating as expected (e.g. when
the bind fails, etc.).
You might want to refine that routine as necessary, and also
write similar entries (to the same logfile) whenever a new process is
being created. Or generally add more debug logging... to get a clearer picture
of what's going on. (You could maybe use MailScanner::Log::InfoLog() instead
of using an extra logfile. Not sure though if that would work properly
— haven't looked at how it's implemented...)
Also, what exactly is your ExitLogging() doing?
| [reply] [d/l] [select] |
| [reply] |
I finally managed to find that the DBI::trace_msg error is being caused by the $sth->prepare line. When it hits that line, it tries errors and tries to print the error message, but for some reason DBI::trace_msg is not defined and THAT causes an error as well. So now I know where the error is, but not what the error is since the error reporting process is blown up as well. I've checked mysql and the permissions for that username and password are correct and working.
| [reply] |