libdb.pm.in 10.9 KB
Newer Older
1
2
3
4
#!/usr/bin/perl -w
use English;
require Mysql;

5
6
# A library of useful DB stuff. Mostly things that get done a lot.
# Saves typing.
7

8
9
10
11
package libdb;
use Exporter;
@ISA = "Exporter";
@EXPORT =
12
13
14
15
16
17
18
19
20
21
    qw ( NODERELOADING_PID NODERELOADING_EID NODEDEAD_PID NODEDEAD_EID
	 NODEBOOTSTATUS_OKAY NODEBOOTSTATUS_FAILED NODEBOOTSTATUS_UNKNOWN
	 NODESTARTSTATUS_NOSTATUS PROJMEMBERTRUST_NONE PROJMEMBERTRUST_USER
	 PROJMEMBERTRUST_TRUSTED DBLIMIT_NSFILESIZE

	 TBAdmin NodeAccessCheck ProjMember ExpLeader MarkNodeDown
	 SetNodeBootStatus OSFeatureSupported IsShelved NodeidToExp
	 UIDInfo DBQuery DBQueryFatal DBQueryWarn DBWarn DBFatal DBQuoteSpecial

	 );
22

23
24
25
# Configure variables
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
26
my $TBOPS       = "@TBOPSEMAIL@";
27
28

#
29
30
# Set up for querying the database. Note that fork causes a reconnect
# to the DB in the child. 
31
32
33
# 
my $DB = Mysql->connect("localhost", $DBNAME, "script", "none");

34
35
36
37
38
#
# Record last DB error string.
#
my $DBErrorString = "";

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#
# Define exported "constants". Basically, these are just perl subroutines
# that look like constants cause you do not need to call a perl subroutine
# with parens. That is, FOO and FOO() are the same thing.
#
sub NODERELOADING_PID()		{ "testbed"; }
sub NODERELOADING_EID()		{ "reloading"; }
sub NODEDEAD_PID()		{ "emulab-ops"; }
sub NODEDEAD_EID()		{ "hwdown"; }

sub NODEBOOTSTATUS_OKAY()	{ "okay" ; }
sub NODEBOOTSTATUS_FAILED()	{ "failed"; }
sub NODEBOOTSTATUS_UNKNOWN()	{ "unknown"; }
sub NODESTARTSTATUS_NOSTATUS()	{ "none"; }

54
55
56
57
58
59
60
61
#
# We want valid project membership to be non-zero for easy membership
# testing. Specific trust levels are encoded thusly.
# 
sub PROJMEMBERTRUST_NONE()	{ 0; }
sub PROJMEMBERTRUST_USER()	{ 1; }
sub PROJMEMBERTRUST_TRUSTED()	{ 2; }

62
63
64
65
66
#
# We should list all of the DB limits.
#
sub DBLIMIT_NSFILESIZE()	{ (1024 * 16); }

67
#
68
69
# Test admin status. Optional argument is the UID or Name to test. If not
# provided, then test the current UID.
70
#
71
72
73
# XXX Argument is *either* a numeric UID, or a string name.
#
# usage: TBAdmin([int or char* uid]);
74
75
76
77
78
79
#        returns 1 if an admin type.
#        returns 0 if a mere user.
# 
sub TBAdmin(;$)
{
    my($uid) = @_;
80
    my($name);
81
82
83
84
85

    if (!defined($uid)) {
	$uid = $UID;
    }

86
87
88
89
90
91
92
93
94
95
    #
    # Test if numeric. Map to name if it is.
    # 
    if ($uid =~ /^[0-9]+$/) {
	($name) = getpwuid($uid)
	    or die "$uid not in passwd file\n";
    }
    else {
	$name = $uid;
    }
96
97

    my $query_result =
98
	DBQueryFatal("select admin from users where uid='$name'");
99
100
101
102
103
104
105
106
107

    my @row = $query_result->fetchrow_array();
    if ($row[0] == 1) {
	return 1;
    }
    return 0;
}

#
108
109
110
# Check access permission to a list of nodes. First argument is a *reference*
# to a single node, or a list of nodes. Second argument is optional uid,
# defaults to the current uid.
111
112
113
#
# usage: NodeAccessCheck(array or scalar \@nodelist, [int uid])
#        returns 1 if the uid is allowed to muck with all the nodes.
114
115
#        returns 0 if the uid is not allowed to muck with at least one of the
#                  nodes.
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#
sub NodeAccessCheck($;$)
{
    my($list, $uid) = @_;
    my(@nodelist);

    if (!defined($uid)) {
	$uid = $UID;
    }

    if (ref($list) eq "ARRAY") {
	@nodelist = @$list;
    }
    elsif (ref($list) eq "SCALAR") {
	@nodelist = ($$list);
    }

    if (!defined(@nodelist) ||
	scalar(@nodelist) == 0) {
	die("NodeAccessCheck:\n".
	    "  First parameter should be a reference to a node (scalar), ".
	    "or a list of nodes!\n");
    }

    #
    # Admin types can do anything to any node. So can Root.
    #
    if ($uid == 0 || TBAdmin($uid)) {
	return 1;
    }

    my ($name) = getpwuid($uid)
	or die "$uid not in passwd file\n";

    #
    # Check to make sure that mere user is allowed to muck with nodes.
    #
    foreach my $node (@$nodelist) {
	my $query_result =
155
156
157
158
159
	    DBQueryFatal("select reserved.node_id from reserved ".
			 "left join proj_memb on ".
			 "reserved.pid=proj_memb.pid and ".
			 "reserved.node_id='$node' ".
			 "where proj_memb.uid='$name'");
160

161
	if ($query_result->numrows == 0) {
162
163
164
165
166
167
168
169
170
	    return 0;
	}
    }
    return 1;
}

#
# Check project membership. First argument is the project to check.
# Second argument is optional uid, defaults to the current uid.
171
# The return argument encodes the trust membership for members. 
172
173
#
# usage: ProjMember(char *pid, [int uid])
174
175
176
#        returns PROJMEMBERTRUST_NONE if uid is not a member or trust=none.
#        returns PROJMEMBERTRUST_USER if uid is a mere user in pid.
#        returns PROJMEMBERTRUST_ROOT if uid is a root user in pid.
177
178
179
180
181
182
183
184
185
186
187
188
189
# 
sub ProjMember($;$)
{
    my($pid, $uid) = @_;

    if (!defined($uid)) {
	$uid = $UID;
    }

    my ($name) = getpwuid($uid)
	or die "$uid not in passwd file\n";

    my $query_result =
190
	DBQueryFatal("select trust from proj_memb where ".
191
		     "uid='$name' and pid='$pid'");
192

193
    if ($query_result->numrows == 0) {
194
	return PROJMEMBERTRUST_NONE;
195
    }
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

    my @row = $query_result->fetchrow_array();
    if ($row[0] eq "none") {
	return PROJMEMBERTRUST_NONE;
    }
    if ($row[0] eq "user") {
	return PROJMEMBERTRUST_USER;
    }
    if ($row[0] eq "group_root" || $row[0] eq "local_root") {
	return PROJMEMBERTRUST_ROOT;
    }
    #
    # Should never happen.
    #
    DBFatal("Improper response in ProjMember()");
211
212
}

213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
#
# Return Experiment leader. First argument pid. Second argument is eid.
#
# usage: ExpLeader(char *pid, char *eid)
#        returns char *leader if a valid pid/eid.
#        returns 0 if an invalid pid/eid.
# 
sub ExpLeader($$)
{
    my($pid, $eid) = @_;

    my $query_result =
	DBQueryFatal("select expt_head_uid from experiments ".
		     "where eid='$eid' and pid='$pid'");

    if ($query_result->numrows == 0) {
	return 0;
    }

    my @row = $query_result->fetchrow_array();
    return $row[0];
}

#
# Mark a node as down, moving it to special pid/eid. First argument is nodeid.
#
# usage: MarkNodeDown(char *nodeid)
#
sub MarkNodeDown($)
{
    my($node) = $_[0];
244
245
246
247
    my($pid, $eid);

    $pid = NODERELOADING_PID;
    $eid = NODERELOADING_EID;
248
249

    my $query_result =
250
	DBQueryFatal("update reserved set pid='$pid', eid='$eid' ".
251
252
253
254
255
256
257
		     "where node_id='$node'");

    if ($query_result->num_rows < 1) {
	DBWarn("WARNING: Could not mark $node down");
    }
}

258
259
260
261
262
263
264
265
266
267
268
269
270
#
# Set the boot status for a node.
#
# usage: SetNodeBootStatus(char *status)
#
sub SetNodeBootStatus($$)
{
    my($node, $bstat) = @_;

    DBQueryFatal("update nodes set bootstatus='$bstat' ".
		 "where node_id='$node'");
}

271
272
273
274
275
276
#
# Check if a particular feature is supported by an OSID. 
#
# usage: OSFeatureSupported(char *osid, char *feature)
#        returns 1 if supported, 0 if not.
#
277
sub OSFeatureSupported($$) {
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    my($osid, $feature) = @_;

    my $query_result =
	DBQueryFatal("select osfeatures from os_info where osid='$osid'");

    # Invalid OSID?
    if ($query_result->numrows < 1) {
	return 0;
    }
    
    foreach my $osfeature (split(',', $query_result->fetchrow_array())) {
	if ($feature eq $osfeature) {
	    return 1;
	}
    }
    return 0;
}

296
297
298
299
300
301
#
# Ah, what a hack! I'm tired of seeing regexs for sharks scattered around
# the code. Anyway, this checks to see if a node is a shelf, and fills
# in the shelf/node, return 1 if it is. The shelf/node arguments are
# optional, if all you want to do is see if its a shelf type thing.
#
302
# usage: IsShelved(char *nodeid, [\$shelf], [\$node])
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
#        returns 1 if the node is a shelf type thing. Optionally fills in info.
#        returns 0 if the node is just a normal kind of node.
#
sub IsShelved ($;$$) {
    my($nodeid, $shelf, $node) = @_;

    if ($nodeid =~ /sh(\d+)-(\d+)/) {
	if (defined($shelf)) {
	    $$shelf = $1;
	}
	if (defined($node)) {
	    $$node = $2;
	}
	return 1;
    }
    return 0;
}

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
#
# Map nodeid to its pid/eid.
#
# usage: NodeToExp(char *nodeid, \$pid, \$eid)
#        returns 1 if the node is reserved.
#        returns 0 if the node is not reserved.
#
sub NodeidToExp ($$$) {
    my($nodeid, $pid, $eid) = @_;

    my $query_result =
	DBQueryFatal("select pid,eid from reserved where node_id='$nodeid'");

    if ($query_result->num_rows < 1) {
	return 0;
    }
    
    my @row = $query_result->fetchrow_array();
    $$pid = $row[0];
    $$eid = $row[1];
    return 1;
}

#
# Map UID to user_login, user_name, and user_email.
#
# usage: UIDInfo(int uid, \$login, \$name, \$email)
#        returns 1 if the UID is okay.
#        returns 0 if the UID is bogus.
#
sub UIDInfo ($$$$) {
    my($uid, $userlogin, $username, $useremail) = @_;

    my($name) = getpwuid($uid)
	or die "$uid not in passwd file\n";

    my $query_result =
	DBQueryFatal("select uid,usr_name,usr_email from users ".
		     "where uid='$name'");

    if ($query_result->num_rows < 1) {
	return 0;
    }

    my @row = $query_result->fetchrow_array();
    $$userlogin = $row[0];
    $$username  = $row[1];
    $$useremail = $row[2];
    return 1;
}

372
373
374
#
# 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
375
376
# as encapsulation of the DB interface. I'm just tired of typing the same
# silly stuff over and over. 
377
378
379
380
# 
# usage: DBQuery(char *str)
#        returns the query object result.
#
381
382
383
384
# 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.
#
385
386
387
388
389
390
391
392
sub DBQuery($)
{
    my($query) = $_[0];
    my($result);

    $result = $DB->query($query);

    if (! $result) {
393
394
395
	$DBErrorString =
	    "  Query: $query\n".
	    "  Error: " . $DB->errstr . "\n";
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
    }
    return $result;
}

#
# Same as above, but die on error. 
# 
sub DBQueryFatal($)
{
    my($query) = $_[0];
    my($result);

    $result = DBQuery($query);

    if (! $result) {
411
	DBFatal("DB Query failed");
412
413
414
415
    }
    return $result;
}

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
#
# Same as above, but just send email on error. This info is useful
# to the TB system, but the caller has to retain control.
# 
sub DBQueryWarn($)
{
    my($query) = $_[0];
    my($result);

    $result = DBQuery($query);

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

433
#
434
# Warn and send email after a failed DB query. First argument is the error
435
436
# message to display. The contents of $DBErrorString is also printed.
# 
437
# usage: DBWarn(char *message)
438
#
439
sub DBWarn($)
440
441
{
    my($message) = $_[0];
442
    my($text, $progname);
443

444
    #
445
    # Must taint check $PROGRAM_NAME cause it comes from outside. Silly!
446
447
448
449
450
451
452
453
454
455
456
    #
    if ($PROGRAM_NAME =~ /^([-\w.\/]+)$/) {
	$progname = $1;
    }
    else {
	$progname = "Tainted";
    }

    $text = "In TB script: $progname\n\n $message\n" . "$DBErrorString";

    print STDERR "$text\n";
457
458
459

    system("echo \"$text\" | /usr/bin/mail ".
	   "-s 'TESTBED: DBFatal - $message' \"$TBOPS\"");
460
461
462
463
464
}

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

    DBWarn($message);
472

473
    exit(1);
474
475
}

476
477
478
479
480
481
482
483
484
485
486
487
488
489
#
# Quote a string for DB insertion.
#
# usage: DBQuoteSpecial(char *string);
#
sub DBQuoteSpecial($)
{
    my($string) = $_[0];

    $string = $DB->quote($string);

    return $string;
}

490
491
1;