batchexp.in 10.8 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
use English;
use Getopt::Std;

#
13 14 15 16
# Create an experiment. The experiment is either run immediately, or
# placed into the batch system to be run later. If no NS file is
# supplied, an experiment shell is created (this is currently an admin
# only option).
17
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
18 19 20 21 22 23 24 25 26
# Exit codes are important; they tell the web page what has happened so
# it can say something useful to the user. Fatal errors are mostly done
# with die(), but expected errors use this routine. At some point we will
# use the DB to communicate the actual error.
#
# $status < 0 - Fatal error. Something went wrong we did not expect.
# $status = 0 - Everything okay.
# $status > 0 - Expected error. User not allowed for some reason. 
# 
27 28
sub usage()
{
29
    die("Usage: batchexp [-i [-f]] [-x expires] [-E description] [-g gid] ".
30 31
	"[-s] [-a <autotime>] [-l <idletime>]] [-n low|high] ".
        "-p <pid> -e <eid> [<nsfile>]\n");
32
}
33 34

my  $optlist = "iE:d:g:x:e:p:sa:l:n:fq";
35 36 37 38 39 40

#
# Configure variables
#
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
41
my $PROJROOT = "/proj";
42
my $EVENTSYS = @EVENTSYS@;
43

44 45 46 47 48 49 50
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;

51
my $parser   = "$TB/libexec/parse-ns";
52 53 54 55
my $mkexpdir = "$TB/libexec/mkexpdir";
my $startexp = "$TB/bin/startexp";
my $tbdata   = "tbdata";
my $immediate= 0;
56
my $frontend = 0;
57
my $quiet    = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
my $errorstat=-1;
59 60
my $dbuid;
my @row;
61 62 63 64 65 66

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

67 68 69 70 71 72 73
#
# 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);

74 75
#
# Untaint the path
76
#
77 78
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
79 80
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

81 82 83 84 85 86
my $eid;
my $pid;
my $gid;
my $description;
my $expires;
my $tempnsfile;
87
my $swappable = 0;
88 89 90 91 92
my $idleswap = 0;
my $idleswaptime = 60 * TBGetSiteVar("idle/threshold");
my $autoswap = 0;
my $autoswaptime = 10 * 60;
my $idleignore = 0;
93 94
my $priority   = TB_EXPTPRIORITY_LOW;
my $exptstate  = EXPTSTATE_NEW();
95

96
#
97
# Verify user and get his DB uid.
98
#
99 100 101
if (! UNIX2DBUID($UID, \$dbuid)) {
    die("*** $0:\n".
        "    You do not exist in the Emulab Database!\n");
102 103 104
}

#
105
# Parse command arguments.
106
#
107 108 109 110
ParseArgs();

#
# Sanity check them.
111
#
112 113 114 115 116 117 118 119
if (!defined($pid) || !defined($eid)) {
    usage();
}
if (!defined($gid)) {
    $gid = $pid;
}
if (defined($description)) {
    $description = DBQuoteSpecial($description);
120 121
}
else {
122 123 124 125
    $description = "'Created by $dbuid'";
}
if (! defined($expires)) {
    $expires = DBDateTime(60 * 60 * 24 * 30);
126
}
127 128 129 130
if (!defined($tempnsfile) && !TBAdmin($dbuid)) {
    die("*** $0:\n".
	"    Only admins can create experiments with no NS file\n");
}
131
$nsfile = "$eid.ns";
132 133

#
134
# Make sure UID is allowed to create experiments in this project.
135
#
136 137 138
if (! TBProjAccessCheck($dbuid, $pid, $gid, TB_PROJECT_CREATEEXPT)) {
    die("*** $0:\n".
	"    You do not have permission to create experiments in $pid/$gid\n");
139 140
}

141 142 143 144 145 146 147 148
#
# If no NS file, then override swap/idle stuff. Again, might change
# when new forms installed
#
if (!defined($tempnsfile)) {
    $swappable     = 0;
    $idleswap      = 0;
}
149 150 151 152 153 154
elsif (! -f $tempnsfile || ! -r $tempnsfile) {
    # Exit so that user sees the error, not us.
    print STDERR "*** $0:\n".
	         "    $tempnsfile does not exist or is not a readable file!\n";
    exit(1);
}
155

156 157 158 159 160 161 162 163 164 165 166
#
# Batch jobs get a shorter idle time
#
my $swaptime = $idleswaptime;
if (!$immediate && TBSiteVarExists("idle/batch_threshold")) {
    my $batchidleswaptime = TBGetSiteVar("idle/batch_threshold");
    if ($swaptime > $batchidleswaptime) {
	$swaptime = $batchidleswaptime;
    }
}

167
#
168 169
# Grab me a secret key for accessing tar/rpm files via the web interface.
# Grab another secret key for the event system HMACs.
170
#
171 172
my $webkey   = TBGenSecretKey();
my $eventkey = TBGenSecretKey();
173

174
#
175 176
# Create an experiment record. The pid/eid has to be unique, so lock the
# table for the check/insert.
177
#
178
DBQueryFatal("lock tables experiments write");
179

180 181 182
$query_result =
    DBQueryFatal("SELECT pid,eid FROM experiments ".
		 "WHERE eid='$eid' and pid='$pid'");
183

184 185 186 187 188
if ($query_result->numrows) {
    DBQueryWarn("unlock tables");
    die("*** $0:\n".
        "    Experiment $eid in project $pid already exists!\n");
}
189 190

#
191 192
# 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
193 194
# will recognize it. We insert the record as locked and ACTIVATING so that
# no one can mess with the experiment until later. 
195
#
196
if (! DBQueryWarn("INSERT INTO experiments ".
197 198
		  "(eid, pid, gid, expt_created, expt_expires, expt_name,".
		  " expt_head_uid,expt_swap_uid, state, priority, swappable,".
199
		  " idleswap, idleswap_timeout, autoswap, autoswap_timeout,".
200
		  " idle_ignore, keyhash, expt_locked, eventkey) ".
201
		  "VALUES ('$eid', '$pid', '$gid', now(), '$expires', ".
202
		  "$description,'$dbuid', '$dbuid', '$exptstate', $priority, ".
203
		  "$swappable, $idleswap, '$swaptime', $autoswap, ".
204
		  "'$autoswaptime', $idleignore, '$webkey', ".
205
		  "now(), '$eventkey')")) {
206 207 208
    DBQueryWarn("unlock tables");
    die("*** $0:\n".
	"    Database error inserting record for $pid/$eid!\n");
209 210
}

211 212
if (! DBQueryWarn("unlock tables")) {
    fatal("Unexpected DB Error!");
213 214
}

215
#
216
# Create an experiment_resources record for the above record.
217 218 219 220 221 222 223 224 225 226
#
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.
227
#
228 229 230 231 232 233 234 235 236 237 238
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");
}

239
#
240
# Create a directory structure for the experiment.
241
#
242 243
if (system("$mkexpdir $pid $gid $eid") != 0) {
    fatal("$mkexpdir failed");
244 245
}

246 247 248 249 250 251 252 253 254 255
#
# Dump the eventkey into a file in the experiment directory. 
#
if ($EVENTSYS) {
    open(KEY, ">" . TBDB_EVENTKEY($pid, $eid)) or
	fatal("Could not create eventkey file: $!");
    print KEY $eventkey;
    close(KEY);
}

256
#
257 258 259
# If no NS file, we are done. We must unlock it and reset its state
# appropriately. We leave the experiment in the "new" state so that
# the user is forced to do a modify first (to give it a topology). 
260
#
261
if (!defined($tempnsfile)) {
262
    TBUnLockExp($pid, $eid, EXPTSTATE_NEW());
263 264
    exit(0);
}
265

266
#
267 268
# Grab the working directory path, and thats where we work.
# The user's experiment directory is off in /proj space.
269
#
270
my $workdir = TBExptWorkDir($pid, $eid);
271

272 273
chdir("$workdir") or
    fatal("Could not chdir to $workdir: $!");
274 275

#
276
# Now we can get the NS file!
277
#
278
if (system("/bin/cp", "$tempnsfile", "$nsfile")) {
279
    fatal("Could not copy $tempnsfile to $workdir/$nsfile");
280
}
281
chmod(0664, "$nsfile");
282

283
#
284 285
# Run parse in impotent mode on the NS file.  This has no effect but
# will display any errors.
286
#
287
if (system("$parser -n $pid $gid $eid $nsfile") != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288 289
    # Obey exit status protocol for web page.
    $errorstat = 1;
290
    fatal("NS Parse failed!");
291 292 293
}

#
294 295 296 297 298
# A batch experiment is essentially preloaded (frontend mode) and then
# dropped into the batch queue, unless the user requested only preload.
# Startexp figures all this out, and in fact this script could easily
# be merged with startexp. Note that we call startexp with the experiment
# locked, and it checks to make sure. 
299
#
300 301 302 303 304
my $optargs = "";
$optargs .= " -f"
    if ($frontend);
$optargs .= " -b"
    if ($quiet);
305

306 307 308 309
if (system("$startexp $optargs -g $gid $pid $eid $nsfile")) {
    # Obey exit status protocol for web page.
    $errorstat = 1;
    fatal("Failed to start experiment $pid/$eid!");
310 311
}
exit(0);
312 313 314 315 316

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

317 318 319
    print STDOUT "*** $0:\n";
    print STDOUT "    $mesg\n";

320 321 322 323 324 325
    #
    # 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).
    #
326
    if (($query_result =
327 328 329 330 331 332 333 334 335
	 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
336
			"WHERE exptidx=$idx");
337 338
	}
    }
339

340
    #
341
    # Clear the record and cleanup.
342
    #
343
    TBExptDestroy($pid, $eid);
344

Leigh B. Stoller's avatar
Leigh B. Stoller committed
345
    exit($errorstat);
346 347 348
}

#
349 350
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
351
#
352
sub ParseArgs()
353
{
354 355 356 357
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }
358

359
    if (@ARGV > 1) {
360 361
	usage();
    }
362 363
    if (@ARGV == 1) {
	$tempnsfile = $ARGV[0];
364

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

374 375
    if (defined($options{"i"})) {
	$immediate = 1;
376
    }
377 378 379
    if (defined($options{"f"})) {
	$frontend = 1;
    }
380 381
    if (defined($options{"p"})) {
	$pid = $options{"p"};
382

383
	if ($pid =~ /^([-\@\w]+)$/) {
384 385
	    $pid = $1;
	}
386 387
	else {
	    die("Bad data in argument: $pid.");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
388
	}
389 390 391 392 393 394 395 396 397
    }
    if (defined($options{"e"})) {
	$eid = $options{"e"};

	if ($eid =~ /^([-\@\w]+)$/) {
	    $eid = $1;
	}
	else {
	    die("Bad data in argument: $eid.");
398
	}
399 400 401 402 403 404
    }
    if (defined($options{"g"})) {
	$gid = $options{"g"};

	if ($gid =~ /^([-\@\w]+)$/) {
	    $gid = $1;
405
	}
406 407
	else {
	    die("Bad data in argument: $gid.");
408 409
	}
    }
410 411 412 413 414 415
    if (defined($options{"x"})) {
	$expires = $options{"x"};
    }
    if (defined($options{"E"})) {
	$description = $options{"E"};
    }
416 417 418
    if (defined($options{"s"})) {
	$swappable = 1;
    }
419 420 421 422 423 424 425 426 427 428 429 430
    if (defined($options{"l"})) {
        $idleswap = 1;
	$idleswaptime = $options{"l"};
	(($idleswaptime =~ /^\d+$/) &&
         ($idleswaptime > 0)) or die("Bad idleswap time: '$idleswaptime'");
    }
    if (defined($options{"a"})) {
        $autoswap = 1;
	$autoswaptime = $options{"a"};
	(($autoswaptime =~ /^\d+$/) &&
         ($autoswaptime > 0)) or die("Bad autoswap time: '$autoswaptime'");
    }
431 432 433
    if (defined($options{"q"})) {
	$quiet = 1;
    }
434 435 436 437 438 439 440 441 442 443 444
    if (defined($options{"n"})) {
	if ($options{"n"} eq "low") {
	    $priority = TB_EXPTPRIORITY_LOW;
	}
	elsif ($options{"n"} eq "high") {
	    $priority = TB_EXPTPRIORITY_HIGH;
	}
	else {
	    usage();
	}
    }
445
}