libtbdb.pm.in 8.6 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2005-2011 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
23 24 25 26 27 28 29 30 31 32 33 34
#

#
# A library of useful DB stuff, currently just for use on ops.
#
package libtbdb;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT =
    qw ( DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal
35
	 DBQuoteSpecial TBDBConnect TBDBDisconnect DBBinaryQuery
36 37 38 39 40
	 );

# Must come after package declaration!
use English;
use File::Basename;
41
require DBI;
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
use vars qw($DBQUERY_MAXTRIES $DBCONN_MAXTRIES @EXPORT_OK);

# Configure variables
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $SCRIPTNAME  = "Unknown";

# Untainted scriptname for email below.
if ($PROGRAM_NAME =~ /^([-\w\.\/]+)$/) {
    $SCRIPTNAME = basename($1);
}
else {
    $SCRIPTNAME = "Tainted";
}

#
# Set up for querying the database. Note that fork causes a reconnect
# to the DB in the child.
#
my $DB;
$DBQUERY_MAXTRIES = 1;
$DBCONN_MAXTRIES  = 5;
@EXPORT_OK        = qw($DBQUERY_MAXTRIES $DBCONN_MAXTRIES);

#
# Need to remember these in case we need to reconnect.
#
my $tbdbname;
my $tbdbuser;
71
my $tbdbhost   = "localhost";
72 73
my $tbdbpasswd = "none";

74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
#############################################################################
# Trivial wrapper for the DBI statement class to avoid a zillion silly
# changes to the rest of the code. These were defined in the Mysql
# wrapper we used to use. Pretty simple stuff, no big deal.
#
package libtbdb_wrapper::DBI::st;
use vars '@ISA';
@ISA = ('DBI::st');

sub dataseek($$)	{ return $_[0]->func($_[1], 'dataseek'); };
sub numrows($)		{ return $_[0]->rows(); };
sub num_rows($)		{ return $_[0]->rows(); };
sub affectedrows($)	{ return $_[0]->rows(); };
sub insertid($)		{ return $_[0]->{'mysql_insertid'}; };
sub fetchrow($)
{
    my ($self) = @_;
    my @row    = $self->fetchrow_array();
    return (@row ? (wantarray ? @row : $row[0]) : ());
}
sub fetchhash($)
{
    my ($self) = @_;
    my $ref    = $self->fetchrow_hashref();
    return ($ref ? %$ref : ());
}

#############################################################################
# Back to the main package.
#
package libtbdb;

106 107 108 109
#
# Database handle passed by reference as 5th argument ($_[4])
#
sub TBDBConnect($;$$$$)
110
{
111
    my ($dbname, $dbuser, $dbpasswd, $dbhost) = @_;
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
    my $maxtries = $DBCONN_MAXTRIES;

    #
    # Construct a 'username' from the name of this script and the user who
    # ran it. This is for accounting purposes.
    #
    if (!defined($dbuser)) {
	my $name = getpwuid($UID);
	if (!$name) {
	    $name = "uid$UID";
	}
	$dbuser = "$SCRIPTNAME:$name:$PID";
    }
    $tbdbname   = $dbname;
    $tbdbuser   = $dbuser;
    $tbdbpasswd = $dbpasswd
	if (defined($dbpasswd));
129 130
    $tbdbhost   = $dbhost
	if (defined($dbhost));
131 132

    while ($maxtries) {
133 134 135
	$DB = DBI->connect("DBI:mysql:database=$tbdbname;host=$tbdbhost",
			   $tbdbuser, $tbdbpasswd,
			   {'PrintError' => 0});
136 137 138 139 140 141 142 143 144 145 146
	if (defined($DB)) {
	    last;
	}
	$maxtries--;
	sleep(1);
    }
    if (!defined($DB)) {
	print STDERR "Cannot connect to DB after several attempts!\n";
	# Ensure consistent error value. 
	return -1;
    }
147 148 149 150 151 152 153
    if (@_ == 5)  {
	$_[4]->{'tbdbname'} = $tbdbname;
	$_[4]->{'tbdbuser'} = $tbdbuser;
	$_[4]->{'tbdbpasswd'} = $tbdbpasswd;
	$_[4]->{'tbdbhost'} = $tbdbhost;
	$_[4]->{'DB'} = $DB;
    }
154 155 156
    return 0;
}

157
sub TBDBDisconnect(;$)
158
{
159 160 161 162 163
    if (defined($_[0])) {
	undef($_[0]->{'DB'});
    } else {
	undef $DB;
    }    
164
}
165
    
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
#
# Record last DB error string.
#
my $DBErrorString = "";

#
# Issue a DB query. Argument is a string. Returns the actual query object, so
# it is up to the caller to test it. I would not for one moment view this
# as encapsulation of the DB interface. I'm just tired of typing the same
# silly stuff over and over.
#
# usage: DBQuery(char *str)
#        returns the query object result.
#
# Sets $DBErrorString is case of error; saving the original query string and
# the error string from the DB module. Use DBFatal (below) to print/email
# that string, and then exit.
#
184
sub DBQuery($;$)
185
{
186 187 188 189 190 191 192
    my($query, $handle)   = @_;
    my $dbhandle;
    if (!defined($handle)) {
	$dbhandle = $DB;
    } else {
	$dbhandle = $handle->{'DB'};
    }
193 194 195 196 197 198 199 200 201
    my $maxtries = $DBQUERY_MAXTRIES;
    my $result;

    # Not really forever :-)
    if (!$maxtries) {
	$maxtries = 100000;
    }

    while ($maxtries) {
202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
	my $sth = $dbhandle->prepare($query);
	if (!$sth) {
	    my $err = $dbhandle->err;

	    $DBErrorString =
		"  Query: $query\n".
		"  Error: " . $dbhandle->errstr() . " ($err)";
	    last;
	}
	my $query_result = $sth->execute();
	if (defined($query_result)) {
	    $sth->{'CompatMode'} = 1;
	    # See above; we add a couple of extra routines.
	    bless($sth, "libtbdb_wrapper::DBI::st");
	    $result = $sth;
	}
	else {
219
	    my $err = $dbhandle->err;
220 221 222

	    $DBErrorString =
		"  Query: $query\n".
223
		"  Error: " . $dbhandle->errstr . " ($err)";
224
	}
225
	if (defined($query_result) ||
226 227 228
	    ($dbhandle->err != 2006) && ($dbhandle->err != 1053) && 
            ($dbhandle->err != 2013) &&
	    ($dbhandle->err != 1046)) {
229 230 231 232 233 234 235 236 237 238 239 240 241
	    last;
	}

	$maxtries--;
	DBWarn("mysqld went away. $maxtries tries left", 0);
	sleep(1);
    }
    return $result;
}

#
# Same as above, but die on error.
#
242
sub DBQueryFatal($;$)
243
{
244
    my ($query, $handle) = @_;
245 246
    my($result);

247
    $result = DBQuery($query, $handle);
248 249 250 251 252 253 254 255 256 257 258

    if (! $result) {
	DBFatal("DB Query failed");
    }
    return $result;
}

#
# Same as above, but just send email on error. This info is useful
# to the TB system, but the caller has to retain control.
#
259
sub DBQueryWarn($;$)
260
{
261
    my ($query, $handle) = @_;
262 263
    my($result);

264
    $result = DBQuery($query, $handle);
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287

    if (! $result) {
	DBWarn("DB Query failed");
    }
    return $result;
}

#
# Warn and send email after a failed DB query. First argument is the error
# message to display. The contents of $DBErrorString is also printed.
#
# usage: DBWarn(char *message)
#
sub DBWarn($;$)
{
    my($message, $nomail) = @_;
    my($text);

    $text = "$message - In $SCRIPTNAME\n" .
  	    "$DBErrorString\n";

    print STDERR "*** $text";

288 289
    if (! defined($nomail) && (exists($INC{'libtestbed.pm'}))) {
        libtestbed::SENDMAIL($TBOPS, "DBError - $message", $text);
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311
    }
}

#
# Same as above, but die after the warning.
#
# usage: DBFatal(char *message);
#
sub DBFatal($)
{
    my($message) = $_[0];

    DBWarn($message);

    die("\n");
}

#
# Quote a string for DB insertion.
#
# usage: char *DBQuoteSpecial(char *string);
#
312
sub DBQuoteSpecial($;$)
313
{
314 315 316 317 318
    my($string, $handle) = @_;
    my $dbhandle;
    if (!defined($handle)) {
	$dbhandle = $DB;
    } else {
319
	$dbhandle = $handle->{'DB'};
320 321
    }
    $string = $dbhandle->quote($string);
322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339

    return $string;
}

#
# Return a (current) string suitable for DB insertion in datetime slot.
# Of course, you can use this for anything you like!
#
# usage: char *DBDateTime(int seconds-to-add);
#
sub DBDateTime(;$)
{
    my($seconds) = @_;

    if (! defined($seconds)) {
	$seconds = 0;
    }

340
	    return strftime("20%y-%m-%d %H:%M:%S", localtime(time() + $seconds));
341 342
}

343 344 345 346 347 348 349 350 351 352 353 354 355
# Binary mode for database query
#
# usage: DBBinaryQuery(dbhandle, statement, @data);
#        returns the query object result.
#
# Sets $DBErrorString is case of error; saving the original query string and
# the error string from the DB module. Use DBFatal to print/email
# that string, and then exit.
#

sub DBBinaryQuery {
   my ($handle, $statement, @data) = @_; 
   
356
   my $dbh = $handle->{'DB'};
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
   my $sth = $dbh->prepare($statement);
   if (!$sth) {
       $DBErrorString =
	   "  Query: $statement\n".
	   "  Error: " . $dbh->errstr() . " ( " . $dbh->err() . ")";
       return undef;
   }
   
   my $query_result = $sth->execute(@data);
   if (!$query_result) {
       $DBErrorString =
	   "  Query: $statement\n".
	   "  Error: " . $dbh->errstr() . " ( " . $dbh->err() . ")";
       return undef;
   }
   $sth->{'CompatMode'} = 1;
373 374
   # See above; we add a couple of extra routines.
   bless($sth, "libtbdb_wrapper::DBI::st");
375 376 377
   $sth;
}

378 379 380 381
# _Always_ make sure that this 1 is at the end of the file...

1;