libdb.pm.in 4.6 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
30
31
32
33
34
35
36
37
38
39
40
41
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
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
114
115
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
#
# Test admin status. Optional argument is the UID to test. If not provided,
# then test the current UID.
#
# usage: TBAdmin([int uid]);
#        returns 1 if an admin type.
#        returns 0 if a mere user.
# 
sub TBAdmin(;$)
{
    my($uid) = @_;

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

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

    my $query_result =
	DBquery("select admin from users where uid='$name'");

    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 =
	    DBquery("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'");

	if ($query_result == 0 ||
	    $query_result->numrows == 0) {
	    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 =
	DBquery("select * from proj_memb where uid='$name' and pid='$pid'");

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

#
# 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
148
149
# as encapsulation of the DB interface. I'm just tired of typing the same
# silly stuff over and over. 
150
151
152
153
# 
# usage: DBQuery(char *str)
#        returns the query object result.
#
154
155
156
157
# 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.
#
158
159
160
161
162
163
164
165
sub DBQuery($)
{
    my($query) = $_[0];
    my($result);

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

    if (! $result) {
166
167
168
	$DBErrorString =
	    "  Query: $query\n".
	    "  Error: " . $DB->errstr . "\n";
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
    }
    return $result;
}

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

    $result = DBQuery($query);

    if (! $result) {
184
	DBFatal("DB Query failed");
185
186
187
188
    }
    return $result;
}

189
190
191
192
193
194
195
196
197
#
# Die and send email after a failed DB query. First argument is the error
# message to display. The contents of $DBErrorString is also printed.
# 
# usage: DBFatal(char *message)
#
sub DBFatal($)
{
    my($message) = $_[0];
198
    my($text, $progname);
199

200
201
202
203
204
205
206
207
208
209
210
211
212
    #
    # Must taint check $PROGRAM_NAME cause it comes from outside.
    #
    if ($PROGRAM_NAME =~ /^([-\w.\/]+)$/) {
	$progname = $1;
    }
    else {
	$progname = "Tainted";
    }

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

    print STDERR "$text\n";
213
214
215
216
217
218
219

    system("echo \"$text\" | /usr/bin/mail ".
	   "-s 'TESTBED: DBFatal - $message' \"$TBOPS\"");

    exit(-1);
}

220
221
1;