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

#
6
7
# A library of useful DB stuff. Mostly things that get done a lot.
# Saves typing.
8
9
10
11
12
13
14
#

#
# Configure variables
#
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
15
my $TBOPS       = "@TBOPSEMAIL@";
16
17
18
19
20
21

#
# Set up for querying the database.
# 
my $DB = Mysql->connect("localhost", $DBNAME, "script", "none");

22
23
24
25
26
#
# Record last DB error string.
#
my $DBErrorString = "";

27
#
28
29
# Test admin status. Optional argument is the UID or Name to test. If not
# provided, then test the current UID.
30
#
31
32
33
# XXX Argument is *either* a numeric UID, or a string name.
#
# usage: TBAdmin([int or char* uid]);
34
35
36
37
38
39
#        returns 1 if an admin type.
#        returns 0 if a mere user.
# 
sub TBAdmin(;$)
{
    my($uid) = @_;
40
    my($name);
41
42
43
44
45

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

46
47
48
49
50
51
52
53
54
55
    #
    # 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;
    }
56
57

    my $query_result =
58
	DBQueryFatal("select admin from users where uid='$name'");
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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
106
107
108
109
110
111
112
113

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

#
# 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.
#
# usage: NodeAccessCheck(array or scalar \@nodelist, [int uid])
#        returns 1 if the uid is allowed to muck with all the nodes.
#        returns 0 if the uid is not allowed to muck with at least one of the nodes.
#
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 =
114
115
116
117
118
	    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'");
119

120
	if ($query_result->numrows == 0) {
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
	    return 0;
	}
    }
    return 1;
}

#
# Check project membership. First argument is the project to check.
# Second argument is optional uid, defaults to the current uid.
#
# usage: ProjMember(char *pid, [int uid])
#        returns 1 if the uid is a member of pid.
#        returns 0 if the uid is not a member of pid.
# 
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 =
147
148
	DBQueryFatal("select * from proj_memb where ".
		     "uid='$name' and pid='$pid'");
149

150
    if ($query_result->numrows == 0) {
151
152
153
154
155
	return 0;
    }
    return 1;
}

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
#
# 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];

    my $query_result =
	DBQueryFatal("update reserved set pid='emulab-ops', eid='hwdown' ".
		     "where node_id='$node'");

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

#
# Check if a particular feature is supported by an OSID. 
#
# usage: OSFeatureSupported(char *osid, char *feature)
#        returns 1 if supported, 0 if not.
#
sub OSFeatureSupported {
    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;
}

222
223
224
#
# 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
225
226
# as encapsulation of the DB interface. I'm just tired of typing the same
# silly stuff over and over. 
227
228
229
230
# 
# usage: DBQuery(char *str)
#        returns the query object result.
#
231
232
233
234
# 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.
#
235
236
237
238
239
240
241
242
sub DBQuery($)
{
    my($query) = $_[0];
    my($result);

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

    if (! $result) {
243
244
245
	$DBErrorString =
	    "  Query: $query\n".
	    "  Error: " . $DB->errstr . "\n";
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
    }
    return $result;
}

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

    $result = DBQuery($query);

    if (! $result) {
261
	DBFatal("DB Query failed");
262
263
264
265
    }
    return $result;
}

266
#
267
# Warn and send email after a failed DB query. First argument is the error
268
269
# message to display. The contents of $DBErrorString is also printed.
# 
270
# usage: DBWarn(char *message)
271
#
272
sub DBWarn($)
273
274
{
    my($message) = $_[0];
275
    my($text, $progname);
276

277
    #
278
    # Must taint check $PROGRAM_NAME cause it comes from outside. Silly!
279
280
281
282
283
284
285
286
287
288
289
    #
    if ($PROGRAM_NAME =~ /^([-\w.\/]+)$/) {
	$progname = $1;
    }
    else {
	$progname = "Tainted";
    }

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

    print STDERR "$text\n";
290
291
292

    system("echo \"$text\" | /usr/bin/mail ".
	   "-s 'TESTBED: DBFatal - $message' \"$TBOPS\"");
293
294
295
296
297
298
299
300
301
302
303
304
}

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

    DBWarn($message);
305

306
    exit(1);
307
308
}

309
310
1;