Commit 05015359 authored by Kevin Atkinson's avatar Kevin Atkinson
Browse files

Merged in changes from tblog-2-branch:

          Move parts of libtblog into libtblog_simple.  Libtblog simple
          provided the basic logging functions but doesn't touch anything.
          Moreover including libtblog_simple doesn't automatically start
          the logging subsystem.  It also doesn't have testbed dependencies
          which mean 1) it can be used in the core testbed libraries (such
          as libdb, libtestbed) without introducing a circular dependency
          and 2) can be used independently.

          Reworked DBFatal and DBWarn to use tblog.  It will still email
          testbed-ops, however.

          Make use of the "cause" field to determine the cause of the bug.
          In particular tblog_find_error will look at the value of this
          field and report the "cause".  In the future different actions
          can be taken based on the ultimate "cause" of the bug, such as if
          testbed-ops should be notified.

          Change format of Error Message reported by libtblog.  As per the
          email "Format or Error Messages" ro testbed-dev.

          Have libtblog use its own Database handle to avoid problems with
          locked tables.

          Also set DBCONN_MAXTRIES to 3 for most important queries.  For
          queries that are not important don't send mail on error.
parent 71ec92da
...@@ -155,6 +155,7 @@ use vars qw(@ISA @EXPORT); ...@@ -155,6 +155,7 @@ use vars qw(@ISA @EXPORT);
TBImageIDAccessCheck TBExptAccessCheck ExpLeader MarkNodeDown TBImageIDAccessCheck TBExptAccessCheck ExpLeader MarkNodeDown
SetNodeBootStatus OSFeatureSupported IsShelved NodeidToExp NodeidToExpOldReserved SetNodeBootStatus OSFeatureSupported IsShelved NodeidToExp NodeidToExpOldReserved
UserDBInfo DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr UserDBInfo DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBErr
NewTBDBHandle DBQueryN DBQueryFatalN DBQueryWarnN DBErrN
DBQuoteSpecial UNIX2DBUID ExpState SetExpState ProjLeader DBQuoteSpecial UNIX2DBUID ExpState SetExpState ProjLeader
ExpNodes ExpNodeVnames ExpNodesOldReserved ExpNodes ExpNodeVnames ExpNodesOldReserved
DBDateTime DefaultImageID GroupLeader TBGroupUnixInfo DBDateTime DefaultImageID GroupLeader TBGroupUnixInfo
...@@ -224,6 +225,7 @@ use vars qw(@ISA @EXPORT); ...@@ -224,6 +225,7 @@ use vars qw(@ISA @EXPORT);
# Must come after package declaration! # Must come after package declaration!
use lib '@prefix@/lib'; use lib '@prefix@/lib';
use libtblog_simple;
use English; use English;
use File::Basename; use File::Basename;
use POSIX qw(strftime); use POSIX qw(strftime);
...@@ -262,13 +264,14 @@ else { ...@@ -262,13 +264,14 @@ else {
# Set up for querying the database. Note that fork causes a reconnect # Set up for querying the database. Note that fork causes a reconnect
# to the DB in the child. # to the DB in the child.
# #
my $DB; my @DB;
$DBQUERY_MAXTRIES = 1; $DBQUERY_MAXTRIES = 1;
$DBCONN_MAXTRIES = 5; $DBCONN_MAXTRIES = 5;
@EXPORT_OK = qw($DBQUERY_MAXTRIES $DBCONN_MAXTRIES); @EXPORT_OK = qw($DBQUERY_MAXTRIES $DBCONN_MAXTRIES);
sub TBDBConnect() sub TBDBConnect($)
{ {
my ($dbnum) = @_;
my $maxtries = $DBCONN_MAXTRIES; my $maxtries = $DBCONN_MAXTRIES;
# #
...@@ -282,28 +285,30 @@ sub TBDBConnect() ...@@ -282,28 +285,30 @@ sub TBDBConnect()
my $dbuser = "$SCRIPTNAME:$name:$PID"; my $dbuser = "$SCRIPTNAME:$name:$PID";
while ($maxtries) { while ($maxtries) {
$DB = Mysql->connect("localhost", $DBNAME, $dbuser, "none"); $DB[$dbnum] = Mysql->connect("localhost", $DBNAME, $dbuser, "none");
if (defined($DB)) { if (defined($DB[$dbnum])) {
last; last;
} }
$maxtries--; $maxtries--;
sleep(1); sleep(1);
} }
if (!defined($DB)) { if (!defined($DB[$dbnum])) {
print STDERR "Cannot connect to DB after several attempts!\n"; print STDERR "Cannot connect to DB after several attempts!\n";
# Ensure consistent error value. # Ensure consistent error value.
exit(-1); exit(-1);
} }
$DB->{'dbh'}->{'PrintError'} = 0; $DB[$dbnum]->{'dbh'}->{'PrintError'} = 0;
$Mysql::QUIET = 1; $Mysql::QUIET = 1;
} }
TBDBConnect(); TBDBConnect(0);
sub TBdbfork() sub TBdbfork()
{ {
select(undef, undef, undef, 0.3); select(undef, undef, undef, 0.3);
undef($DB); for (my $i = 0; $i < @DB; $i++) {
TBDBConnect(); undef($DB[$i]);
TBDBConnect($i);
}
if ($EVENTSYS) { if ($EVENTSYS) {
EventFork(); EventFork();
} }
...@@ -312,10 +317,19 @@ sub TBdbfork() ...@@ -312,10 +317,19 @@ sub TBdbfork()
# To avoid keeping a mysql connection around. # To avoid keeping a mysql connection around.
sub TBDBDisconnect() sub TBDBDisconnect()
{ {
undef($DB); for (my $i = 0; $i < @DB; $i++) {
undef($DB[$i]);
}
select(undef, undef, undef, 0.3); select(undef, undef, undef, 0.3);
} }
# Create a new DB handle and return the handle number
sub NewTBDBHandle() {
my $dbnum = @DB;
TBDBConnect($dbnum);
return $dbnum;
}
# #
# Record last DB error string. # Record last DB error string.
# #
...@@ -4339,21 +4353,22 @@ sub DBQueryOld($) ...@@ -4339,21 +4353,22 @@ sub DBQueryOld($)
my($query) = $_[0]; my($query) = $_[0];
my($result); my($result);
$result = $DB->query($query); $result = $DB[0]->query($query);
if (! $result) { if (! $result) {
$DBErrorString = $DBErrorString =
" Query: $query\n". " Query: $query\n".
" Error: " . $DB->errstr; " Error: " . $DB[0]->errstr;
} }
return $result; return $result;
} }
sub DBQuery($) sub DBQueryN($$)
{ {
my($query) = $_[0]; my($dbnum, $query) = @_;
my $maxtries = $DBQUERY_MAXTRIES; my $maxtries = $DBQUERY_MAXTRIES;
my $result; my $result;
my $db = $DB[$dbnum];
# Not really forever :-) # Not really forever :-)
if (!$maxtries) { if (!$maxtries) {
...@@ -4361,17 +4376,17 @@ sub DBQuery($) ...@@ -4361,17 +4376,17 @@ sub DBQuery($)
} }
while ($maxtries) { while ($maxtries) {
$result = $DB->query($query); $result = $db->query($query);
if (! defined($result)) { if (! defined($result)) {
my $err = $DB->err; my $err = $db->err;
$DBErrorString = $DBErrorString =
" Query: $query\n". " Query: $query\n".
" Error: " . $DB->errstr . " ($err)"; " Error: " . $db->errstr . " ($err)";
} }
if (defined($result) || if (defined($result) ||
($DB->err != 2006) && ($DB->err != 1053) && ($DB->err != 2013) && ($db->err != 2006) && ($db->err != 1053) && ($db->err != 2013) &&
($DB->err != 1046)) { ($db->err != 1046)) {
last; last;
} }
...@@ -4381,39 +4396,42 @@ sub DBQuery($) ...@@ -4381,39 +4396,42 @@ sub DBQuery($)
} }
return $result; return $result;
} }
sub DBQuery($) {return DBQueryN(0,$_[0]);}
# #
# Same as above, but die on error. # Same as above, but die on error.
# #
sub DBQueryFatal($) sub DBQueryFatalN($$)
{ {
my($query) = $_[0]; my($dbnum, $query) = @_;
my($result); my($result);
$result = DBQuery($query); $result = DBQueryN($dbnum, $query);
if (! $result) { if (! $result) {
DBFatal("DB Query failed"); DBFatal("DB Query failed");
} }
return $result; return $result;
} }
sub DBQueryFatal($) {return DBQueryFatalN(0,$_[0]);}
# #
# Same as above, but just send email on error. This info is useful # Same as above, but just send email on error. This info is useful
# to the TB system, but the caller has to retain control. # to the TB system, but the caller has to retain control.
# #
sub DBQueryWarn($) sub DBQueryWarnN($$)
{ {
my($query) = $_[0]; my($dbnum, $query) = @_;
my($result); my($result);
$result = DBQuery($query); $result = DBQueryN($dbnum, $query);
if (! $result) { if (! $result) {
DBWarn("DB Query failed"); DBWarn("DB Query failed");
} }
return $result; return $result;
} }
sub DBQueryWarn($) {return DBQueryWarnN(0,$_[0]);}
# #
# Warn and send email after a failed DB query. First argument is the error # Warn and send email after a failed DB query. First argument is the error
...@@ -4424,16 +4442,8 @@ sub DBQueryWarn($) ...@@ -4424,16 +4442,8 @@ sub DBQueryWarn($)
sub DBWarn($;$) sub DBWarn($;$)
{ {
my($message, $nomail) = @_; my($message, $nomail) = @_;
my($text);
DBError(\&tbwarn, $message, $nomail);
$text = "$message - In $SCRIPTNAME\n" .
"$DBErrorString\n";
print STDERR "*** $text";
if (! defined($nomail)) {
libtestbed::SENDMAIL($TBOPS, "DBError - $message", $text);
}
} }
# #
...@@ -4444,10 +4454,26 @@ sub DBWarn($;$) ...@@ -4444,10 +4454,26 @@ sub DBWarn($;$)
sub DBFatal($) sub DBFatal($)
{ {
my($message) = $_[0]; my($message) = $_[0];
DBError(\&tbdie, $message);
}
DBWarn($message); #
# DBError, common parts of DBWarn and DBFatal
#
# usage: DBError(log function, message, nomail)
#
sub DBError($$;$)
{
my($f, $message, $nomail) = @_;
if (! defined($nomail)) {
libtestbed::SENDMAIL($TBOPS, "DBError - $message",
"$message - In $SCRIPTNAME\n".
"$DBErrorString\n");
}
die("\n"); $f->({cause=>'software'}, "$message:\n$DBErrorString");
} }
# #
...@@ -4459,7 +4485,7 @@ sub DBQuoteSpecial($) ...@@ -4459,7 +4485,7 @@ sub DBQuoteSpecial($)
{ {
my($string) = $_[0]; my($string) = $_[0];
$string = $DB->quote($string); $string = Mysql->quote($string);
return $string; return $string;
} }
...@@ -4467,9 +4493,13 @@ sub DBQuoteSpecial($) ...@@ -4467,9 +4493,13 @@ sub DBQuoteSpecial($)
# #
# Get the Error From the Last Database query # Get the Error From the Last Database query
# #
sub DBErrN($)
{
return $DB[$_[0]]->err;
}
sub DBErr() sub DBErr()
{ {
return $DB->err; return $DB[0]->err;
} }
# #
...@@ -5308,4 +5338,3 @@ sub TBSetNodeHistory($$$$$) ...@@ -5308,4 +5338,3 @@ sub TBSetNodeHistory($$$$$)
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
...@@ -56,7 +56,7 @@ LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \ ...@@ -56,7 +56,7 @@ LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
snmpit_foundry.pm snmpit_stack.pm snmpit_remote.pm \ snmpit_foundry.pm snmpit_stack.pm snmpit_remote.pm \
snmpit_nortel.pm \ snmpit_nortel.pm \
libaudit.pm libreboot.pm libosload.pm libtestbed.py \ libaudit.pm libreboot.pm libosload.pm libtestbed.py \
libadminmfs.pm libtblog.pm libArchive.pm \ libadminmfs.pm libtblog.pm libtblog_simple.pm libArchive.pm \
power_mail.pm power_whol.pm power_mail.pm power_whol.pm
# #
......
...@@ -766,7 +766,8 @@ while (1) { ...@@ -766,7 +766,8 @@ while (1) {
$precheck = 1; $precheck = 1;
my $retval = RunAssign(); my $retval = RunAssign();
if ($retval != 0) { if ($retval != 0) {
fatal({type=>'extra'}, "Experiment can not be run on an empty testbed. Please fix the experiment."); fatal({type=>'extra', cause=>'user'},
"Experiment can not be run on an empty testbed. Please fix the experiment.");
} }
print("Assign succeeded on an empty testbed.\n"); print("Assign succeeded on an empty testbed.\n");
$precheck = 0; $precheck = 0;
......
...@@ -13,8 +13,9 @@ ...@@ -13,8 +13,9 @@
BEGIN {$FAKE_SCRIPTNAME = $ARGV[0];} BEGIN {$FAKE_SCRIPTNAME = $ARGV[0];}
use lib "@prefix@/lib"; use lib "@prefix@/lib";
use libtblog; use libtblog qw(:DEFAULT dblog *SOUT *SERR);
use libtblog qw(dblog *SOUT *SERR);
tblog_set_default_cause('temp');
use strict; use strict;
...@@ -98,3 +99,11 @@ if ($exitcode) { ...@@ -98,3 +99,11 @@ if ($exitcode) {
} }
exit $exitcode; exit $exitcode;
...@@ -34,7 +34,8 @@ use Exporter; ...@@ -34,7 +34,8 @@ use Exporter;
@ISA = "Exporter"; @ISA = "Exporter";
@EXPORT = qw (tblog tberror tberr tbwarn tbwarning tbnotice tbinfo tbdebug @EXPORT = qw (tblog tberror tberr tbwarn tbwarning tbnotice tbinfo tbdebug
tbdie tblog_set_info tblog_sub_process tblog_find_error tbdie tblog_set_info tblog_set_default_cause
tblog_sub_process tblog_find_error
tblog_capture tblog_stop_capture tblog_capture tblog_stop_capture
tblog_new_process tblog_init_process tblog_exit tblog_new_process tblog_init_process tblog_exit
copy_hash copy_hash
...@@ -43,11 +44,12 @@ use Exporter; ...@@ -43,11 +44,12 @@ use Exporter;
@EXPORT_OK = qw (dblog *SOUT *SERR); @EXPORT_OK = qw (dblog *SOUT *SERR);
# After package decl. # After package decl.
use English; # DO NOT USE "use English" in this module
use POSIX qw(isatty setsid); use POSIX qw(isatty setsid);
use File::Basename; use File::Basename;
use IO::Handle; use IO::Handle;
use Text::Wrap; use Text::Wrap;
use Carp;
use strict; use strict;
...@@ -56,40 +58,14 @@ use strict; ...@@ -56,40 +58,14 @@ use strict;
# #
use lib "@prefix@/lib"; use lib "@prefix@/lib";
use libtestbed; use libtestbed;
use libdb; use libdb qw(NewTBDBHandle DBQueryN DBQueryWarnN DBQueryFatalN
DBQuoteSpecial $DBQUERY_MAXTRIES DBWarn DBFatal);
use libtblog_simple;
sub if_defined($$); my $REAL_SCRIPTNAME = $SCRIPTNAME;
undef $SCRIPTNAME; # signal to use $ENV{TBLOG_SCRIPTNAME}
my %PRIORITY_MAP_TO_NUM; my $DB;
my %PRIORITY_MAP_TO_STR;
my $REAL_SCRIPTNAME = basename($PROGRAM_NAME);
#
# Duplicate STDOUT and STDERR to SOUT and SERR respectfully, since
# tblog_capture() will redirect the real STDOUT and STDERR
#
open SOUT ,">&=STDOUT"; # Must be "&=" not "&" to avoid creating a
# new low level file descriper as the
# interacts strangly with the fork in swapexp.
autoflush SOUT 1;
open SERR ,">&=STDERR"; # Ditto
autoflush SERR 1;
#
# Make constants for the error level, the sub, prefixed with TBLOG_,
# are exported, the non-prefixed variables are used internally
#
sub TBLOG_EMERG {000} my $EMERG = 000;
sub TBLOG_ALERT {100} my $ALRET = 100;
sub TBLOG_CRIT {200} my $CRIT = 200;
sub TBLOG_ERR {300} my $ERR = 300;
sub TBLOG_WARNING {400} my $WARNING = 400;
sub TBLOG_NOTICE {500} my $NOTICE = 500;
sub TBLOG_INFO {600} my $INFO = 600;
sub TBLOG_DEBUG {700} my $DEBUG = 700;
# #
# Internal Utility Functions # Internal Utility Functions
...@@ -97,13 +73,13 @@ sub TBLOG_DEBUG {700} my $DEBUG = 700; ...@@ -97,13 +73,13 @@ sub TBLOG_DEBUG {700} my $DEBUG = 700;
sub check_env_def ( $ ) sub check_env_def ( $ )
{ {
die "Environment variable \"$_[0]\" not defined." unless defined $_[0]; croak "Environment variable \"$_[0]\" not defined" unless defined $_[0];
} }
sub check_env_num ( $ ) sub check_env_num ( $ )
{ {
check_env_def $_[0]; check_env_def $_[0];
die "Environment variable \"$_[0]\" not a positive integer." croak "Environment variable \"$_[0]\" not a positive integer"
unless $ENV{$_[0]} =~ /^[0-9]+$/; unless $ENV{$_[0]} =~ /^[0-9]+$/;
} }
...@@ -120,17 +96,32 @@ sub check_env () ...@@ -120,17 +96,32 @@ sub check_env ()
check_env_def 'TBLOG_BASE_SCRIPTNAME'; check_env_def 'TBLOG_BASE_SCRIPTNAME';
} }
sub if_defined ($$) { my %CAUSE_MAP = (# Don't notify testbed-ops
return $_[0] if defined $_[0]; temp => 'temp', # resources temp unavailable
return $_[1] if defined $_[1]; user => 'user', # user error
return ''; # Notify testbed-ops
internal => 'software', # software bug, should not happen
software => 'software', # software problem, like a bad image
hardware => 'hardware', # hardware problem
unknown => '');
sub normalize_cause ( $ ) {
my $cause = $CAUSE_MAP{$_[0]};
croak "Unknown cause \"$cause\"" unless defined $cause;
return $cause;
} }
sub oneof ($@) { #
my ($to_find) = shift; #
my @res = grep {$to_find eq $_} @_; #
return @res > 0;
}
#
# Standard DBQuery functions from dblog but use private database handle
#
sub DBQuery ( $ ) {return DBQueryN($DB, $_[0]);}
sub DBQueryFatal ( $ ) {return DBQueryFatalN($DB, $_[0]);}
sub DBQueryWarn ( $ ) {return DBQueryWarnN($DB, $_[0]);}
# #
# Like DBQueryFatal but also fail if the query didn't return any results # Like DBQueryFatal but also fail if the query didn't return any results
...@@ -138,7 +129,7 @@ sub oneof ($@) { ...@@ -138,7 +129,7 @@ sub oneof ($@) {
sub DBQuerySingleFatal ( $ ) sub DBQuerySingleFatal ( $ )
{ {
my ($query) = @_; my ($query) = @_;
my $query_result = DBQueryFatal $query; my $query_result = DBQueryFatalN($DB, $query);
DBFatal("DB Query \"$query\" didn't return any results") DBFatal("DB Query \"$query\" didn't return any results")
unless $query_result->numrows > 0; unless $query_result->numrows > 0;
my @row = $query_result->fetchrow_array(); my @row = $query_result->fetchrow_array();
...@@ -162,15 +153,15 @@ sub informative_scriptname(); ...@@ -162,15 +153,15 @@ sub informative_scriptname();
# than call tblog_new_process # than call tblog_new_process
# #
sub tblog_init() { sub tblog_init() {
# Get priority mapping # Connect to database
my $query_result = DBQueryFatal "SELECT * FROM priorities"; $DB = NewTBDBHandle();
for (my $i = 0; $i < $query_result->num_rows; $i++) {
my ($n,$v) = $query_result->fetchrow_array(); # Reset default cause
$PRIORITY_MAP_TO_STR{$n} = $v;
$PRIORITY_MAP_TO_NUM{uc $v} = $n; $ENV{TBLOG_CAUSE} = '';
$PRIORITY_MAP_TO_NUM{lc $v} = $n;
}