batchexp.in 8.31 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6
7
8
# All rights reserved.
#

9
10
11
12
13
14
15
16
use English;
use Getopt::Std;

#
# Create a batch experiment.
#
sub usage()
{
17
    die("Usage: batchexp [-i [-f]] [-x expires] [-E description] [-g gid] ".
18
	"[-s] [-n low|high] -p <pid> -e <eid> <nsfile>\n");
19
}
20
my  $optlist = "iE:d:g:x:e:p:sn:f";
21
22
23
24
25
26

#
# Configure variables
#
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
27
my $PROJROOT = "/proj";
28

29
30
31
32
33
34
35
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;

36
my $parser   = "$TB/libexec/ns2ir/parse-ns";
37
38
39
40
my $mkexpdir = "$TB/libexec/mkexpdir";
my $startexp = "$TB/bin/startexp";
my $tbdata   = "tbdata";
my $immediate= 0;
41
my $frontend = 0;
42
43
my $dbuid;
my @row;
44
45
46
47
48
49

#
# Turn off line buffering on output
#
$| = 1;

50
51
52
53
54
55
56
#
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
#
umask(0002);

57
58
59
#
# Untaint the path
# 
60
61
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
62
63
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

64
65
66
67
68
69
my $eid;
my $pid;
my $gid;
my $description;
my $expires;
my $tempnsfile;
70
71
my $swappable = 0;
my $priority  = TB_EXPTPRIORITY_LOW;
72

73
#
74
# Verify user and get his DB uid.
75
#
76
77
78
if (! UNIX2DBUID($UID, \$dbuid)) {
    die("*** $0:\n".
        "    You do not exist in the Emulab Database!\n");
79
80
81
}

#
82
# Parse command arguments.
83
#
84
85
86
87
88
89
90
91
92
93
94
95
96
ParseArgs();

#
# Sanity check them.
# 
if (!defined($pid) || !defined($eid)) {
    usage();
}
if (!defined($gid)) {
    $gid = $pid;
}
if (defined($description)) {
    $description = DBQuoteSpecial($description);
97
98
}
else {
99
100
101
102
    $description = "'Created by $dbuid'";
}
if (! defined($expires)) {
    $expires = DBDateTime(60 * 60 * 24 * 30);
103
104
}

105
$nsfile = "$eid.ns";
106
107

#
108
# Make sure UID is allowed to create experiments in this project.
109
#
110
111
112
if (! TBProjAccessCheck($dbuid, $pid, $gid, TB_PROJECT_CREATEEXPT)) {
    die("*** $0:\n".
	"    You do not have permission to create experiments in $pid/$gid\n");
113
114
115
}

#
116
117
# Create an experiment record. The pid/eid has to be unique, so lock the
# table for the check/insert.
118
#
119
DBQueryFatal("lock tables experiments write");
120

121
122
123
$query_result =
    DBQueryFatal("SELECT pid,eid FROM experiments ".
		 "WHERE eid='$eid' and pid='$pid'");
124

125
126
127
128
129
if ($query_result->numrows) {
    DBQueryWarn("unlock tables");
    die("*** $0:\n".
        "    Experiment $eid in project $pid already exists!\n");
}
130
131

#
132
133
134
# Insert the record. This reserves the pid/eid for us. If its a batchmode
# experiment, we will update the record later so that the batch daemon
# will recognize it. 
135
#
136
137
if (! DBQueryWarn("INSERT INTO experiments ".
		  "(eid, pid, gid, expt_created, expt_expires, ".
138
		  " expt_name, expt_head_uid, state, priority, swappable) ".
139
		  "VALUES ('$eid', '$pid', '$gid', now(), '$expires', ".
140
		  "$description, '$dbuid', 'new', $priority, $swappable)")) {
141
142
143
    DBQueryWarn("unlock tables");
    die("*** $0:\n".
	"    Database error inserting record for $pid/$eid!\n");
144
145
}

146
147
if (! DBQueryWarn("unlock tables")) {
    fatal("Unexpected DB Error!");
148
149
}

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
#
# Create an experiment_resources record for the above record. 
#
if (! DBQueryWarn("insert into experiment_resources (idx, tstamp, exptidx) ".
		  "select 0, now(), idx from experiments ".
		  "where pid='$pid' and eid='$eid'")) {
    DBQueryWarn("unlock tables");
    fatal("DB error inserting experiment resources record for $pid/$eid!\n");
}

#
# Now create an experiment_stats record to match.
# 
if (! DBQueryWarn("insert into experiment_stats ".
		  "(eid, pid, creator, gid, created, batch, exptidx,rsrcidx) ".
		  "select '$eid', '$pid', '$dbuid', '$gid', now(), ".
		  ($immediate ? 0 : 1) .
		  ", e.idx,r.idx from experiments as e ".
		  "left join experiment_resources as r on e.idx=r.exptidx ".
		  "where pid='$pid' and eid='$eid'")) {
    DBQueryWarn("unlock tables");
    fatal("DB error inserting experiment stats record for $pid/$eid!\n");
}

174
#
175
# Create a directory structure for the experiment.
176
#
177
178
if (system("$mkexpdir $pid $gid $eid") != 0) {
    fatal("$mkexpdir failed");
179
180
181
}

#
182
183
# Grab the working directory path, and thats where we work.
# The user's experiment directory is off in /proj space.
184
#
185
my $workdir = TBExptWorkDir($pid, $eid);
186

187
188
chdir("$workdir") or
    fatal("Could not chdir to $workdir: $!");
189
190
191
192

#
# Now we can get the NS file! 
#
193
if (system("/bin/cp", "$tempnsfile", "$nsfile")) {
194
    fatal("Could not copy $tempnsfile to $workdir/$nsfile");
195
}
196
chmod(0664, "$nsfile");
197

198
#
199
200
# Run parse in impotent mode on the NS file.  This has no effect but
# will display any errors.
201
#
202
if (system("$parser -n -a $nsfile") != 0) {
203
    fatal("NS Parse failed!");
204
205
206
}

#
207
# Shove a copy of the NS file into the DB to make Mike happy.
208
#
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
$nsfile_string = `cat $nsfile`;

if ($nsfile_string) {
    $nsfile_string = DBQuoteSpecial($nsfile_string);

    DBQueryWarn("delete from nsfiles WHERE eid='$eid' and pid='$pid'");

    #
    # I could strlen check the string, but the webserver has a limit,
    # plus the DB is going to truncate it if its longer. Doing it here
    # would be a third (call it redundant) check. 
    # 
    DBQueryWarn("insert into nsfiles (pid, eid, nsfile) ".
		"VALUES('$pid', '$eid', $nsfile_string)");
}
224
225

#
226
227
228
229
230
231
# Check for immediate or batch experiment. If immediate, fire off the
# the startexp script to do the rest. It exits and so do we; user gets
# email later. If its a batch experiment, update the experiment record
# so that the batch daemon will see it and act.
# 
if ($immediate) {
232
233
234
    my $farg = ($frontend ? "-f" : "");
    
    if (system("$startexp $farg -g $gid $pid $eid $nsfile")) {
235
236
237
	fatal("Failed to start experiment $pid/$eid!");
    }
}
238
239
240
241
242
243
244
245
246
247
else {
    #
    # Preload the experiment in the foreground. User sees parse errors
    # right away, and the experiment is now in the system so we can look
    # at it.
    # 
    if (system("$startexp -f -b -g $gid $pid $eid $nsfile")) {
	fatal("Failed to preload batch experiment $pid/$eid!");
    }
    TBSetBatchState($pid, $eid, BATCHSTATE_POSTED);
248
}
249

250
exit(0);
251
252
253
254
255

sub fatal($)
{
    my($mesg) = $_[0];

256
257
258
    print STDOUT "*** $0:\n";
    print STDOUT "    $mesg\n";

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
    #
    # Generally, we do not delete the stats/resource record, but if we
    # failed at this point, no point in keeping the record. Just a
    # waste of space since the testbed_stats log indicates there was a
    # failure and why (sorta, via the exit code).
    #
    if (($query_result = 
	 DBQueryWarn("select idx from experiments ".
		     "where pid='$pid' and eid='$eid'"))) {

	my ($idx) = $query_result->fetchrow_array;

	if (defined($idx) && $idx) {
	    DBQueryWarn("DELETE from experiment_stats ".
			"WHERE eid='$eid' and pid='$pid' and exptidx=$idx");
	    DBQueryWarn("DELETE from experiment_resources ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
275
			"WHERE exptidx=$idx");
276
277
278
	}
    }
    
279
    #
280
281
    # Clear the record and cleanup.
    # 
282
    TBExptDestroy($pid, $eid);
283
    
284
285
286
287
    exit(-1);
}

#
288
289
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
290
#
291
sub ParseArgs()
292
{
293
294
295
296
297
298
299
300
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
    
    if (@ARGV != 1) {
	usage();
    }
301

302
303
304
305
    $tempnsfile = $ARGV[0];
    
    if (defined($options{"i"})) {
	$immediate = 1;
306
    }
307
308
309
310
311
312
    if (defined($options{"f"})) {
	$frontend = 1;
    }
    if ($frontend && !$immediate) {
	usage();
    }
313
314
    if (defined($options{"p"})) {
	$pid = $options{"p"};
315

316
	if ($pid =~ /^([-\@\w]+)$/) {
317
318
	    $pid = $1;
	}
319
320
	else {
	    die("Bad data in argument: $pid.");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
321
	}
322
323
324
325
326
327
328
329
330
    }
    if (defined($options{"e"})) {
	$eid = $options{"e"};

	if ($eid =~ /^([-\@\w]+)$/) {
	    $eid = $1;
	}
	else {
	    die("Bad data in argument: $eid.");
331
	}
332
333
334
335
336
337
    }
    if (defined($options{"g"})) {
	$gid = $options{"g"};

	if ($gid =~ /^([-\@\w]+)$/) {
	    $gid = $1;
338
	}
339
340
	else {
	    die("Bad data in argument: $gid.");
341
342
	}
    }
343
344
345
346
347
348
    if (defined($options{"x"})) {
	$expires = $options{"x"};
    }
    if (defined($options{"E"})) {
	$description = $options{"E"};
    }
349
350
351
352
353
354
355
356
357
358
359
360
361
362
    if (defined($options{"s"})) {
	$swappable = 1;
    }
    if (defined($options{"n"})) {
	if ($options{"n"} eq "low") {
	    $priority = TB_EXPTPRIORITY_LOW;
	}
	elsif ($options{"n"} eq "high") {
	    $priority = TB_EXPTPRIORITY_HIGH;
	}
	else {
	    usage();
	}
    }
363
364
365
366
367
368
369
370

    # Note different taint check (allow /).
    if ($tempnsfile =~ /^([-\@\w.\/]+)$/) {
	$tempnsfile = $1;
    }
    else {
	fatal("Bad data in argument: $tempnsfile");
    }
371
}