template_create.in 31 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
23 24
#
use English;
25
use strict;
26 27 28 29
use Getopt::Std;
use POSIX qw(isatty setsid);
use POSIX qw(strftime);
use Errno qw(EDQUOT);
30
use Cwd qw(realpath);
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

#
# Create a new experiment template. 
#
# 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. 
# 
sub usage()
{
    print(STDERR
47
	  "Usage: template_create [-q] [-w] [-E description]\n".
48
	  "          [-m guid/vers] [-g gid] <pid> <tid> <input file>\n".
49
	  "switches and arguments:\n".
50 51 52 53 54 55 56 57
	  "-w        - wait for template to be created.\n".
	  "-m <guid> - Modify existing template.\n".
	  "-q        - be less chatty\n".
	  "-E <str>  - A pithy sentence describing the template\n".
	  "-g <gid>  - The group in which to create the experiment\n".
	  "<pid>     - The project in which to create the experiment\n".
	  "<tid>     - The template name (alphanumeric, no blanks)\n".
	  "<input>   - Input file for experiment.\n");
58 59
    exit(-1);
}
60
my $optlist	 = "qwE:g:m:f:r:";
61 62 63
my $quiet        = 0;
my $waitmode     = 0;
my $modify       = 0;
64 65
my $repotag;
my $repobase;
66
my $needrepoinit = 0;
67
my $frompath;
68
my $description;
69 70 71 72
my $pid;
my $tid;
my $gid;
my $inputfile;
73
my $logfile;
74
my $logname;
75 76 77
# For modify.
my $parent_guid;
my $parent_vers;
78
my $parent_template;
79 80 81 82 83 84 85 86 87 88 89

#
# Configure variables
#
my $TB		= "@prefix@";
my $EVENTSYS	= @EVENTSYS@;
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
my $TBDOCBASE	= "@TBDOCBASE@";
my $TBBASE	= "@TBBASE@";
my $CONTROL	= "@USERNODE@";
90
my $STAMPS      = @STAMPS@;
91 92

# Locals
93
my $template;
94
my $guid;
95 96
my $vers;
my $eid;
97 98 99
my $cvsdir;
my $tmpdir;
my $archive;
100
# For the END block below.
101
my $cleaning    = 0;
102
my $exptcreated = 0;
103
my $justexit    = 1;
104 105 106 107 108 109

# Programs we need
my $checkquota  = "$TB/sbin/checkquota";
my $batchexp    = "$TB/bin/batchexp";
my $endexp      = "$TB/bin/endexp";
my $makegraph   = "$TB/bin/template_graph";
110 111
my $CVSBIN      = "/usr/bin/cvs";
my $RLOG        = "/usr/bin/rlog";
112 113 114 115 116 117 118 119 120 121 122 123

# Protos
sub ParseArgs();
sub fatal($$);

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libtblog;
124
use libArchive;
125
use Template;
126
use libaudit;
127
use Project;
128
use User;
129

130 131 132 133 134
# In libdb
my $projroot = PROJROOT();

# Temporary
$libtestbed::SYSTEM_DEBUG = 1;
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155

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

#
# 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);

#
# Untaint the path
#
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
156
# Verify user and get his DB uid and other info for later.
157
#
158 159 160
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    tbdie("You ($UID) do not exist!");
161
}
162 163 164 165
my $user_dbid  = $this_user->dbid();
my $user_uid   = $this_user->uid();
my $user_name  = $this_user->name();
my $user_email = $this_user->email();
166 167 168 169 170

#
# Before doing anything else, check for overquota ... lets not waste
# our time. Make sure user sees the error by exiting with 1.
#
171
if (system("$checkquota $user_uid") != 0) {
172 173
    tberror("You are over your disk quota on $CONTROL; ".
	    "please login there and cleanup!");
174 175 176 177 178 179 180 181 182
    exit(1);
}

# Now parse arguments.
ParseArgs();

#
# Make sure UID is allowed to create experiments in this project.
#
183 184 185 186 187 188
my $project = Project->Lookup($pid, $eid);
if (!defined($project)) {
    tbdie("Could not map project $pid/$eid to its object!");
}
if (! $project->AccessCheck($this_user, TB_PROJECT_CREATEEXPT)) {
    tbdie("You do not have permission to create templates in $pid/$gid");
189 190 191 192 193 194
}

#
# On modify, must check access to the parent template.
#
if ($modify) {
195 196 197
    $parent_template = Template->Lookup($parent_guid, $parent_vers);

    if (!defined($parent_template)) {
198 199
	tbdie("Experiment template $parent_guid/$parent_vers does not exist!");
    }
200

201
    if (!$parent_template->AccessCheck($user_uid, TB_EXPT_READINFO)) {
202 203 204
	tbdie("You do not have permission to modify experiment template ".
	      "$parent_guid/$parent_vers");
    }
205 206 207 208 209

    $description = $parent_template->description()
	if (!defined($description));
}
else {
210
    $description = "Created by $user_uid"
211
	if (! defined($description));
212 213
}

214 215 216 217 218 219 220 221
#
# In wait mode, block SIGINT until we spin off the background process.
#
if ($waitmode) {
    $SIG{QUIT} = 'IGNORE';
    $SIG{TERM} = 'IGNORE';
    $SIG{INT}  = 'IGNORE';
}
222

223
#
224
# Create a template record now, so we know what it is.
225 226 227 228 229 230 231 232 233 234
#
my %args = ();

if ($modify) {
    $args{'parent_guid'} = $parent_guid;
    $args{'parent_vers'} = $parent_vers;
}
$args{'pid'}         = $pid;
$args{'gid'}         = $gid;
$args{'tid'}         = $tid;
235 236
$args{'uid'}         = $user_uid;
$args{'uid_idx'}     = $user_dbid;
237 238 239
$args{'description'} = DBQuoteSpecial($description);
$args{'description'} =~ s/^\'(.*)\'$/$1/;

240
if (! ($template = Template->Create(\%args))) {
241 242 243
    tbdie("Could not create a new template record!");
}

244 245 246 247 248
if ($STAMPS) {
    if ($modify) {
	$parent_template->Stamp("template_create", "modified");
	
	$template->Stamp("template_create", "creating",
Leigh Stoller's avatar
Leigh Stoller committed
249
			 "parent_version", $parent_vers);
250 251
    }
    else {
Leigh Stoller's avatar
Leigh Stoller committed
252
	$template->Stamp("template_create", "creating", "", 0);
253
    }
254 255
}

256 257 258 259 260 261 262 263 264
#
# The template gets its own directory structure. 
#
if (my $rval = $template->CreateDirectory()) {
    $template->Delete();
    tbdie("Failed to create directories for template");
}
my $template_dir = $template->path();

265 266 267 268 269 270
#
# At this point, we need to force a cleanup no matter how we exit.
# See the END block below.
#
$justexit = 0;

271
# Grab stuff we need out of the template.
272 273 274 275 276
$guid   = $template->guid();
$vers   = $template->vers();
$eid    = $template->eid();
$cvsdir = "$projroot/$pid/templates/$guid/cvsrepo";
$tmpdir = "$projroot/$pid/templates/$guid/cvstmp.$$";
277 278 279 280

#
# Use the logonly option to audit so that we get a record mailed.
#
281 282
$logfile = $template->CreateLogFile("template_create");
if (!defined($logfile)) {
283
    fatal(-1, "Could not create a logfile");
284 285 286 287 288
}
$logname = $logfile->filename();
# We want it to spew to the web.
$template->SetLogFile($logfile) == 0 or
    fatal(-1, "Could not set the logfile");
289 290 291
$template->OpenLogFile() == 0 or
    fatal(-1, "Could not open the logfile");

292
if (my $childpid =
293 294
    AuditStart(LIBAUDIT_DAEMON, $logname,
	       LIBAUDIT_LOGONLY|LIBAUDIT_FANCY|LIBAUDIT_NODELETE)) {
295 296 297 298 299 300 301
    #
    # Parent exits normally, unless in waitmode. We have to set
    # justexit to make sure the END block below does not run.
    #
    $justexit = 1;
    
    if (!$waitmode) {
302
	print("Template $guid/$vers is being created. Watch your email.\n")
303 304 305
	    if (! $quiet);
	exit(0);
    }
306 307
    print("Waiting for template $guid/$vers to be created. ".
	  "Please be patient!\n")
308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
	if (! $quiet);

    # Give child a chance to run.
    select(undef, undef, undef, 0.25);
	
    #
    # Reset signal handlers. User can now kill this process, without
    # stopping the child.
    #
    $SIG{TERM} = 'DEFAULT';
    $SIG{QUIT} = 'DEFAULT';
    $SIG{INT}  = 'DEFAULT';

    #
    # Wait until child exits or until user gets bored and types ^C.
    #
    waitpid($childpid, 0);
    my $exit_code = $? >> 8;

    print("Done. Exited with status: $?\n")
	if (! $quiet);

    if ($exit_code == 0) {
        # Web interface depends on this line. Bad; need another way to send
        # back the newly generated guid/version.
	print "Template $guid/$vers has been created\n";
    }
    else {
	my $d = tblog_lookup_error();
	print tblog_format_error($d);
    }
    
    exit $exit_code;
}

343 344 345 346 347 348 349
# Add audit info.  Right now this will only work when called in
# the child of the script being audited.  Eventually these can be
# set anywhere.
AddAuditInfo("which", "$pid/$tid");
AddAuditInfo("failure_frag", "Template Creation Failure");
AddAuditInfo("success_frag", "New Template Created");

350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
#
# We need to catch TERM so we can kill the children and do a cleanup.
#
sub handler ($) {
    my ($signame) = @_;
    
    $SIG{TERM} = 'IGNORE';
    my $pgrp = getpgrp(0);
    kill('TERM', -$pgrp);
    sleep(1);
    fatal(-1, "Caught SIG${signame}! Killing template setup ...");
}
$SIG{TERM} = \&handler;
$SIG{QUIT} = 'DEFAULT';

365 366 367
#
# Set up CVS repo on ops to use as alternate interface.
#
368 369 370 371
if (!$modify || ! -e $cvsdir) {
    $needrepoinit = 1
	if (! -e $cvsdir);
	
372 373 374 375 376 377 378 379 380 381 382 383 384 385 386
    if (! mkdir("$cvsdir", 0777)) {
	fatal(-1, "Could not mkdir $cvsdir: $!");
    }
    if (! chmod(0777, "$cvsdir")) {
	fatal(-1, "Could not chmod $cvsdir: $!");
    }
    # Init the CVS control files.
    System("$CVSBIN -d $cvsdir init") == 0
	or fatal(-1, "Could not initialize $cvsdir");

    open(GUID, ">$cvsdir/CVSROOT/GUID") or
	fatal(-1, "Could not create cookie file in CVSROOT directory");
    print GUID "$guid\n";
    close(GUID);

387 388
    System("cd $cvsdir/CVSROOT; co -l config taginfo") == 0
	or fatal(-1, "Could not lock $cvsdir/CVSROOT/config");
389 390 391 392

    System("cp -fp $TB/lib/cvsroot/* $cvsdir/CVSROOT") == 0
	or fatal(-1, "Could not copy cvsroot files to $cvsdir/CVSROOT!");

393 394 395 396 397 398
    open(CONFIG, ">> $cvsdir/CVSROOT/config") 
	or fatal(-1, "Could not open $cvsdir/CVSROOT/config for writing");
    print CONFIG "\n";
    print CONFIG "# Added for Emulab Testbed; DO NOT DELETE!\n";
    print CONFIG "TemplateCommit=$TB/sbin/rtag_commit\n";
    close(CONFIG);
399
}
400

401 402 403 404 405 406 407 408 409 410 411
#
# We stick in a little cookie file so we know what template this is,
# from within the CVS repo (well, sandbox).
#
open(COOKIE, "> $template_dir/.template") or
    fatal(-1, "Could not create cookie file in stub import directory");
print COOKIE "# DO NOT REMOVE THIS FILE OR MODIFY THIS FILE, EVER!\n";
print COOKIE "GUID: $guid/$vers\n";
print COOKIE "TIME: " . time() . "\n";
close(COOKIE);

412
if (defined($repotag)) {
413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457
    #
    # We need to get a checkout from the repo for both the nsfile and
    # the datastore directory.
    #
    mkdir("$tmpdir", 0777) or
	fatal(-1, "Could not mkdir $tmpdir: $!");

    #
    # Need the numeric revision corresponding to the tag. From that we can
    # determine the branch tag.
    #
    my $revision;
    
    open(TAGLOG, "$cvsdir/CVSROOT/tags") or
	fatal(-1, "Could not open $cvsdir/CVSROOT/tags for reading");
    while (<TAGLOG>) {
	if ($_ =~ /^$repotag,\s*([\w]+),\s*([\d\.]+)$/) {
	    print "$repotag $1 at revision $2\n";
	    if ($1 eq "add" || $1 eq "mov") {
		$revision = $2;
	    }
	    else {
		$revision = undef;
	    }
	}
    }
    close(TAGLOG);
    if (!defined($revision)) {
	fatal(-1, "Could not find base revision for $repotag");
    }
    #
    # And now the branch tag that this tag is on. Split the revision
    # up so we can find the second to last token. Basically, if
    # 1.2.2.1 is the revision, then the branch tag has a revision
    # number that looks like 1.2.0.2 (magic). The HEAD is special of
    # course.
    #
    my @tokens = split(/\./, $revision);
    if (scalar(@tokens) > 2) {
	my $branchtag;
	
	$tokens[scalar(@tokens)-1] = $tokens[scalar(@tokens)-2];
	$tokens[scalar(@tokens)-2] = 0;
	my $branchrev = join(".", @tokens);
    
458
	open(RLOG, "$RLOG -h $cvsdir/setup/.template,v |")
459
	    or fatal(-1,
460
		     "Could not run rlog on $cvsdir/setup/.template,v!");
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
	my $intags = 0;
	while (<RLOG>) {
	    if ($intags) {
		# Look for end of tag section. Consume rest of input file.
		if ($_ =~ /^[\w]+/) {
		    while (<RLOG>) {
			;
		    }
		    last;
		}
		# Otherwise process tags ...
		if ($_ =~ /^\s+([-\w]+):\s+([\d\.]+)$/) {
		    #print "tag $1 at revision $2\n";
		    if ($branchrev eq $2) {
			$branchtag = $1;
		    }
		}
		next;
	    }
	    # Look for the start of the tag section.
	    if ($_ =~ /^symbolic names:/) {
		$intags = 1;
	    }
	}
	close(RLOG);
	if (!defined($branchtag)) {
	    fatal(-1, "Could not find branch tag for revision $revision!");
	}
	$repobase = $branchtag;
490 491

	# Checkout ...
492
	System("cd $tmpdir; $CVSBIN -d $cvsdir checkout ".
493
	       "  -r $repotag setup")
494
	    == 0 or fatal(-1, "Could not checkout '$repotag' from $cvsdir");
495
    }
496 497
    else {
	# Checkout along trunk, no -r option cause then commit fails
498
	System("cd $tmpdir; $CVSBIN -d $cvsdir checkout -r HEAD setup")
499 500 501 502 503
	    == 0 or fatal(-1, "Could not checkout trunk from $cvsdir");

	#
	# Clear the default branch so that checkout gives us the trunk.
	#
504
	System("cd $tmpdir; $CVSBIN -d $cvsdir admin -b")
505 506 507
	    == 0 or fatal(-1, "Could not clear default branch in $cvsdir");

	# And clear the sticky tag so later commit works.
508
	System("cd $tmpdir/setup; $CVSBIN -d $cvsdir update -A")
509 510 511
	    == 0 or fatal(-1, "Could not update to head trunk from $cvsdir");
    }

512
    $inputfile = "$tmpdir/setup/tbdata/nsfile.ns";
513 514
    fatal(-1, "NS file missing from repo checkout!")
	if (!-e $inputfile);
515
}
516

517 518 519
#
# The description is versioned metadata the user can modify.
#
520
$template->NewMetadata("description", $description,
521
		       $this_user, "template_description") == 0
522 523 524 525 526
    or fatal(-1, "Failed to insert metadata record for description");

#
# The TID is versioned metadata the user can modify.
#
527
$template->NewMetadata("TID", $tid, $this_user, "tid") == 0
528 529
    or fatal(-1, "Failed to insert metadata record for description");

530
# Now invoke batchexp to preload the experiment. Note special -x option.
531
system("$batchexp ". 
532
       "-x $guid/$vers" . ($modify ? ",$parent_guid/$parent_vers" : "") . " " .
533
       "-q -i -f -E 'Experiment Template Preload $guid/$vers' ".
534 535 536 537 538 539 540
       "-p $pid -e $eid $inputfile");
fatal($? >> 8, "Oops")
    if ($?);

# Need to kill the experiment if we fail after this point.
$exptcreated = 1;

541 542 543 544
if ($STAMPS) {
    $template->Stamp("template_create", "batchexp");
}

545
# Input files are kept in the DB, with the template.
546 547 548
fatal(-1, "Could not add NS file to template store")
    if ($template->AddInputFile($inputfile) < 0);

549
#
550
# Grab archive index for new templates. 
551
#
552 553
libArchive::TBExperimentArchive($pid, $eid, \$archive, undef)
    >= 0 or fatal(-1, "Could not get archive for $template!");
554 555 556

# And update the record.
%args = ();
557
$args{'archive_idx'} = $archive->idx();
558

559
$template->Update(\%args) == 0
560 561
    or fatal(-1, "Could not update template record!");

562 563 564 565 566
#
# When creating a template, the archive is created (or forked) in batchexp
# but it is not committed. We need to do that now cause this experiment
# is never actually swapped in. Instead each instance is a new fork, and if
# the archive were not committed, it would not look correct.
567 568
# Before we do that though, we want to copy the datastore directory to the
# child since we *do* want that stuff shared.
569
#
570 571 572 573
if ($modify) {
    print "Committing archive before copying data store\n";
    libArchive::TBCommitExperimentArchive($pid, $eid, "template_modify")
	>= 0 or fatal(-1, "Failed to commit experiment archive!");
574

575
    if (defined($repotag)) {
576
	$template->ImportDataStore("$tmpdir/setup/datastore") == 0
577 578 579
	    or fatal(-1, "Failed to import data store");
    }
    elsif (defined($frompath)) {
580 581 582 583 584 585 586
	$template->ImportDataStore("$frompath/datastore") == 0
	    or fatal(-1, "Failed to import data store");
    }
    else {
	$template->CopyDataStore($parent_template, $user_uid) == 0
	    or fatal(-1, "Failed to copy data store");
    }
587 588 589 590 591

    # and tell the archive library about the above files.
    libArchive::TBExperimentArchiveAddUserFiles($pid, $eid) == 0
	or fatal(-1, "Failed to add datastore files to the archive!");
}
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609

# Make a copy of the inputfile in the template_dir so that it finds its
# way into the user accessible CVS repo. This is also where the datastore
# gets copied to for import.
system("cp -p $inputfile $template_dir/tbdata/nsfile.ns") == 0
    or fatal(-1, "Could not copy $inputfile to $template_dir/tbdata");

# Need this so the datastore directory looks populated in the CVS repo.
if (! -e "$template_dir/datastore/.ignore") {
    System("cd $template_dir/datastore; touch .ignore")
	== 0 or fatal(-1,
		      "Could not touch .ignore in $template_dir/datastore");
}

#
# When the template is first created, import an initial vendor branch
# into the CVS repo so that there is something there. 
#
610
if (!$modify || $needrepoinit) {
611 612
    System("cd $template_dir; ".
	   "$CVSBIN -d $cvsdir import ".
613
	   "  -m 'Initialize new cvs repo for template $guid' setup ".
614
	   "  T${guid}-${vers}_import_branch T${guid}-${vers}_import")
615 616
	== 0 or fatal(-1, "Could not import new template into $cvsdir");

617 618 619 620
    # Create the records module with a simple mkdir. Harmless.
    mkdir("$cvsdir/records", 0777) or
	fatal(-1, "Could not mkdir $cvsdir/records: $!");

621 622 623 624 625 626 627 628
    #
    # Must advance the head past 1.1 since that is where the imports are done
    # and it will confuse everything later.
    #
    mkdir("$tmpdir", 0777) or
	fatal(-1, "Could not mkdir $tmpdir: $!");

    # Checkout ...
629
    System("cd $tmpdir; $CVSBIN -d $cvsdir checkout setup")
630 631 632
	== 0 or fatal(-1, "Could not checkout from $cvsdir");

    # Commit ...
633
    System("cd $tmpdir/setup; $CVSBIN -d $cvsdir commit -f -R ".
634 635 636
	     "  -m 'Commit initial import back to head'")
	== 0 or fatal(-1, "Could not commit to $cvsdir");

637
    # No keyword subst.
638
    System("cd $tmpdir/setup; $CVSBIN -Q -d $cvsdir admin -kb")
639
	== 0 or fatal(-1, "Could not set -kb in $cvsdir");
640

641 642 643
    #
    # Now tag the CVS repo with the current guid/vers so we can find it easily.
    #
644
    System("$CVSBIN -d $cvsdir rtag -n T${guid}-${vers} setup")
645
	== 0 or fatal(-1, "Could not rtag initial version in $cvsdir");
646 647 648 649 650 651 652 653 654 655 656 657 658 659

    # Setup the records directory.
    System("cd $tmpdir; $CVSBIN -d $cvsdir checkout records")
	== 0 or fatal(-1, "Could not checkout from $cvsdir");

    System("cd $tmpdir/records; touch .ignore") == 0 or
	fatal(-1, "Could not create $tmpdir/records/.ignore");
 
    System("cd $tmpdir/records; $CVSBIN -d $cvsdir add .ignore")
	== 0 or fatal(-1, "Could not cvs add $tmpdir/records/.ignore!");
    
    System("cd $tmpdir/records; $CVSBIN -d $cvsdir commit -f -R ".
	     "  -m 'Commit initial records directory'")
	== 0 or fatal(-1, "Could not commit records to $cvsdir");
660 661 662 663 664 665 666 667 668
}
elsif ($frompath) {
    #
    # When modifying a template from an instance we need to import the
    # new files into the CVS repo and then merge/commit back to the
    # current head (of the branch).
    #
    # Not going to deal with this now.
}
669
elsif (defined($repotag)) {
670 671 672 673 674
    #
    # Need to commit the new version of .template on the new branch so
    # that when the user does a checkout of the branch, it says what
    # template it is (and what to template to modify on the next branch).
    #
675 676
    System("cp -p $template_dir/.template $tmpdir/setup") == 0
	or fatal(-1, "Could not cp $template_dir/.template to $tmpdir");
677 678

    # Check the file in.
679
    System("cd $tmpdir/setup; ".
680 681
	   "$CVSBIN commit " . (defined($repobase) ? "-r $repobase " : " ") .
	   "  -m 'Update guid after modify' .template")
682
	== 0 or fatal(-1, "Could not commit final version in $cvsdir");
683 684 685 686
    
    #
    # Tag the CVS repo with the current guid/vers so we can find it easily.
    #
687 688
    System("$CVSBIN -d $cvsdir rtag -n " .
	   (defined($repobase) ? "-r $repobase " : " ") .
689
	   "   T${guid}-${vers} setup")
690 691 692 693 694 695 696 697 698 699 700
	== 0 or fatal(-1, "Could not rtag final version in $cvsdir");

    #
    # Clear the default branch so that "update -A" takes user to trunk.
    #
    System("cd $tmpdir; $CVSBIN -d $cvsdir admin -b")
	== 0 or fatal(-1, "Could not clear default branch in $cvsdir");
}
else {
    mkdir("$tmpdir", 0777) or
	fatal(-1, "Could not mkdir $tmpdir: $!");
701

702 703
    my $athead = 0;

704 705 706 707
    #
    # To support older templates, see if the parent is in the CVS repo.
    # If not, skip all this. 
    #
708 709
    my $ptag = "T${parent_guid}-${parent_vers}";
    my $revision = `$RLOG -h $cvsdir/setup/.template,v | grep '${ptag}:'`;
710 711
    goto noparent
	if ($?);
712

713 714 715 716 717 718 719 720 721 722 723 724 725
    # Split out the revision number.
    if ($revision =~ /^.*:\s+([\d.]+)$/) {
	$revision = $1;
    }
    else {
	fatal(-1, "Could not parse '$revision'");
    }

    #
    # We want to know if the parent is on the trunk and at the head.  If it
    # is, then continue along the trunk, otherwise need to create a branch
    # off the parent. This makes it nice for the common case that most
    # people work along the the trunk.
726
    #
727 728 729 730
    # XXX Potential problem here; even though the .template file is at the
    # head revision on the trunk, there is no way to know where all the
    # other files are. If the user has been good to his CVS tree, then
    # things will probably work most of the time, but ...
731
    #
732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758
    chomp($revision);
    my @tokens = split(/\./, $revision);
    if (scalar(@tokens) == 2) {
	my $header = `$RLOG -h $cvsdir/setup/.template,v | egrep '^head:'`;
	if ($?) {
	    fatal(-1, "Could not determine head revision for ".
		  "$cvsdir/setup/.template,v");
	}
	if ($header =~ /^head:\s+([\d.]+)$/) {
	    if ("$1" eq "$revision") {
		$athead = 1;
	    }
	}
	else {
	    fatal(-1, "Could not parse ($header) head revision for ".
		  "$cvsdir/setup/.template,v");
	}
    }

    if (!$athead) {
        #
        # Create a branch off the parent template for this new template
        #
	System("$CVSBIN -d $cvsdir rtag -n -r T${parent_guid}-${parent_vers} ".
	       " -b T${parent_guid}-${vers}_branch setup ") 
	    == 0 or fatal(-1, "Could not rtag parent version in $cvsdir");
    }
759 760
    
    #
761 762
    # Import onto new branch in the vendor branch.
    # Then commit to a new (branch) head.
763 764 765
    #
    System("cd $template_dir; ".
	   "$CVSBIN -d $cvsdir import -b 1.1.${vers} ".
766
	   "  -m 'Modify cvs repo for template $guid/$vers' setup ".
767
	   "  T${guid}-${vers}_import_branch T${guid}-${vers}_import")
768 769
	== 0 or fatal(-1, "Could not import modified template into $cvsdir");

770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792
    if ($athead) {
	# Checkout and merge
	System("cd $tmpdir; $CVSBIN -d $cvsdir checkout ".
	       "  -j HEAD -j T${guid}-${vers}_import_branch setup")
	    == 0 or fatal(-1, "Could not checkout/merge from $cvsdir");

        # Commit ...
	System("cd $tmpdir/setup; $CVSBIN -d $cvsdir commit -f -R ".
	       "  -m 'Commit merge with head'")
	    == 0 or fatal(-1, "Could not commit on $cvsdir");
    }
    else {
	# Checkout and merge
	System("cd $tmpdir; $CVSBIN -d $cvsdir checkout ".
	       "  -r T${parent_guid}-${vers}_branch ".
	       "  -j T${parent_guid}-${vers}_branch ".
	       "  -j T${guid}-${vers}_import_branch setup")
	    == 0 or fatal(-1, "Could not checkout/merge from $cvsdir");

	# Need to clear the -b (default branch) or else the merge
	# commit fails for some reason that makes no sense to me.
	System("cd $tmpdir; $CVSBIN -d $cvsdir admin -b setup") == 0
	    or fatal(-1, "Could not clear default branch (-b) on $cvsdir");
793
    
794 795 796 797 798 799
        # Commit ...
	System("cd $tmpdir/setup; $CVSBIN -d $cvsdir commit -f -R ".
	       "  -r T${parent_guid}-${vers}_branch  ".
	       "  -m 'Commit merge with head'")
	    == 0 or fatal(-1, "Could not commit on $cvsdir");
    }
800
    
801 802 803
    #
    # Clear the default branch so that "update -A" takes user to trunk.
    #
804
    System("cd $tmpdir; $CVSBIN -d $cvsdir admin -b setup")
805 806
	== 0 or fatal(-1, "Could not clear default branch in $cvsdir");

807
    # No keyword subst.
808
    System("cd $tmpdir; $CVSBIN -Q -d $cvsdir admin -kb setup")
809 810
	== 0 or fatal(-1, "Could not set -kb in $cvsdir");
    
811
    #
812 813
    # Now tag the CVS repo with the current guid/vers so we can
    # find it easily.
814
    #
Leigh Stoller's avatar
Leigh Stoller committed
815
    System("$CVSBIN -d $cvsdir rtag -n ".	
816 817
	   "  -r " . ($athead ? "HEAD" : "T${parent_guid}-${vers}_branch") .
	   "  T${guid}-${vers} setup")
818
	== 0 or fatal(-1, "Could not rtag final version in $cvsdir");
819
noparent:
820
}
821 822
System("/bin/rm -rf $tmpdir")
    if (-e $tmpdir);
823

824 825
# Do a savepoint prior to the commit below. As noted above, this is
# not done in batchexp.
826 827 828
#print "Doing a savepoint\n";
#libArchive::TBExperimentArchiveSavePoint($pid, $eid, "CopyDataStore") >= 0
#    or fatal(-1, "Failed to do a savepoint on the experiment archive!");
829

830
print "Doing final commit\n";
831 832 833
libArchive::TBCommitExperimentArchive($pid, $eid, "TemplateCreate")
    >= 0 or fatal(-1, "Failed to commit experiment archive!");

834 835 836 837 838 839
#
# Copy the virt_parameters table to the formal parameters table.
# I am not sure about the need for this table yet, but the only way
# to get the parameters is via the parser, but we want to save this
# info forever (after the underlying experiment is terminated).
#
840
my $query_result =
841
    DBQueryWarn("select name,value,description from virt_parameters ".
842 843 844 845 846
              "where pid='$pid' and eid='$eid'");

fatal(-1, "Could not get virt_parameters for $pid/$eid")
    if (! $query_result);

847
while (my ($name, $value, $description) = $query_result->fetchrow_array()) {
848
    $template->NewFormalParameter($name, $value, $description, $this_user) == 0
849 850
	or fatal(-1, "Could not set formal parameter for $pid/$eid")
}
851 852 853 854 855 856

#
# Copy the rest of the metadata from parent to child.
# XXX This has to be done after the previous step (virt_parameters)
#
if ($modify) {
857
    $template->CopyMetadata($parent_template, $this_user) == 0
858 859 860
	or fatal(-1, "Failed to copy metadata records");
}
   
861
#
862 863
# Generate the graph for the template.
#
864 865
print "Generating graph\n";
system("$makegraph -s $guid");
866 867 868
fatal(-1, "Error generating template graph.")
    if ($?);

869 870 871 872
#
# Make the new template active (and the parent template inactive) if the
# parent was already active.
#
Leigh Stoller's avatar
Leigh Stoller committed
873
if ($modify && $parent_template->IsActive()) {
874 875 876 877
    $parent_template->InActivate();
    $template->Activate();
}

878 879 880 881 882 883 884 885 886 887 888 889
#
# Update parent to point to most recent child.
#
if ($modify) {
    %args = ();

    $args{'child_guid'} = $template->guid();
    $args{'child_vers'} = $template->vers();

    $parent_template->Update(\%args) == 0
	or fatal(-1, "Could not update parent template record!");
}
890 891 892
if ($STAMPS) {
    $template->Stamp("template_create", "created");
}
893 894 895 896 897

#
# Clear the log file so the web page stops spewing. 
#
$template->CloseLogFile()
898
    if (defined($logfile));
899

900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959
exit(0);

#
# Parse command arguments. Once we return from getopts, all that are
# left are the required arguments.
#
sub ParseArgs()
{
    my %options = ();
    if (! getopts($optlist, \%options)) {
	usage();
    }

    if (@ARGV < 2 || @ARGV > 3) {
	usage();
    }
    #
    # Pick up pid/tid first and untaint.
    #
    $pid = shift(@ARGV);

    if ($pid =~ /^([-\w]+)$/) {
	$pid = $1;
    }
    else {
	tbdie("Bad data in argument: $pid.");
    }
    if (! TBcheck_dbslot($pid, "projects", "newpid",
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	tbdie("Improper project name (id)!");
    }
    
    $tid = shift(@ARGV);

    if ($tid =~ /^([-\w]+)$/) {
	$tid = $1;
    }
    else {
	tbdie("Bad data in argument: $tid.");
    }
    if (! TBcheck_dbslot($tid, "experiments", "eid",
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	tbdie("Improper template name (id)!");
    }
    if (@ARGV) {
	$inputfile = $ARGV[0];

	# Note different taint check (allow /).
	if ($inputfile =~ /^([-\w\.\/]+)$/) {
	    $inputfile = $1;
	}
	else {
	    tbdie("Bad data in input file: $inputfile");
	}

	#
	# Called from ops interactively. Make sure NS file in /proj or /users.
	#
	# Use realpath to resolve any symlinks.
	#
960
	my $translated = realpath($inputfile);
961 962 963 964 965 966 967 968
	if ($translated =~ /^([-\w\.\/]+)$/) {
	    $inputfile = $1;
	}
	else {
	    tbdie("Bad data returned by realpath: $translated");
	}

	#
969 970 971 972 973 974 975
	# The file must reside in an acceptible location. Since this script
	# runs as the caller, regular file permission checks ensure it is a
	# file the user is allowed to use.  So we don't have to be too tight
	# with the RE matching /tmp and /var/tmp files.  Note that
	# /tmp/$guid-$nsref.nsfile is also allowed since this script is
	# invoked directly from web interface which generates a name that
	# should not be guessable.
976 977 978 979
	#
	if (! ($inputfile =~ /^\/tmp\/[-\w]+-\d+\.nsfile/) &&
	    ! ($inputfile =~ /^\/tmp\/\d+\.ns/) &&
	    ! ($inputfile =~ /^\/var\/tmp\/php\w+/) &&
980
	    ! TBValidUserDir($inputfile, 0)) {
981 982 983 984
	    tberror("$inputfile does not resolve to an allowed directory!");
	    # Note positive status; so error goes to user not tbops.
	    exit(1);
	}
985 986 987 988 989 990
	# Copy to a temporary file.
	my $tempnsfile = $inputfile;
	$inputfile = "/tmp/$$.ns";
	if (system("/bin/cp", "$tempnsfile", "$inputfile")) {
	    tberror("Could not copy $tempnsfile to $inputfile");
	}
991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008
    }
    #
    # Optional gid. Defaults to pid.
    #
    if (defined($options{"g"})) {
	$gid = $options{"g"};

	if ($gid =~ /^([-\w]+)$/) {
	    $gid = $1;
	}
	else {
	    tbdie("Bad data in argument: $gid.");
	}
    }
    else {
	$gid = $pid;
    }

1009 1010 1011 1012 1013 1014 1015 1016 1017
    if (defined($options{"f"})) {
	$frompath = $options{"f"};

	# The Archive library has a nice routine to validate this path.
	if (Archive::ValidatePath(\$frompath) != 0) {
	    tbdie("Invalid path $frompath");
	}
    }

1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032
    #
    # Parent pointer, for modify. We always create a new template point
    # it to the parent. 
    #
    if (defined($options{"m"})) {
	if ($options{"m"} =~ /^([\w]*)\/([\d]*)$/) {
	    $parent_guid = $1;
	    $parent_vers = $2;
	    $modify      = 1;
	}
	else {
	    tbdie("Bad data in argument: " . $options{"m"});
	}
    }

1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043
    if (defined($options{"r"})) {
	$repotag = $options{"r"};

	if ($repotag =~ /^([-\w]+)$/) {
	    $repotag  = $1;
	}
	else {
	    tbdie("Bad data in argument: $repotag");
	}
    }

1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071
    if (defined($options{"E"})) {
	if (! TBcheck_dbslot($options{"E"},
			     "experiment_templates", "description",
			     TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
	    tbdie("Improper template description!");
	}
	$description = $options{"E"};
    }

    if (defined($options{"q"})) {
	$quiet = 1;
    }
    if (defined($options{"w"})) {
	$waitmode = 1;
    }
}

#
# Cleanup the mess.
#
sub cleanup()
{
    if ($exptcreated) {
	my $exptidx;

	exit(-1)
	    if (!TBExptIDX($pid, $eid, \$exptidx));
		
1072
	system("$endexp -x -q -w $exptidx");
1073 1074 1075 1076 1077
	exit(-1)
	    if ($?);

	# And delete all the other stuff?
    }
1078
    # Delete repo but only if this is the initial template creation.
1079 1080
    system("/bin/rm -f $inputfile")
	if (defined($inputfile) && -e $inputfile);
1081 1082
    system("/bin/rm -rf $cvsdir")
	if (!$modify && defined($cvsdir) && -e $cvsdir);
1083 1084
    System("/bin/rm -rf $tmpdir")
	if (defined($tmpdir) && -e $tmpdir);
1085 1086
    $template->Delete()
	if (defined($template));
1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103
}

sub fatal($$)
{
    my ($errorstat, $msg) = @_;
    
    tberror $msg;
    tbinfo "Cleaning up and exiting with status $errorstat ...";

    #
    # This exit will drop into the END block below.
    # 
    exit($errorstat);
}

END {
    # Normal exit, nothing to do.
1104
    if (!$? || $justexit) {
1105 1106 1107 1108 1109 1110 1111 1112 1113
	return;
    }
    my $saved_exitcode = $?;
    
    if ($cleaning) {
	#
	# We are screwed; a recursive error. Someone will have to clean
	# up by hand. 
	#
1114
	SENDMAIL($TBOPS, 
1115 1116 1117 1118 1119 1120 1121 1122 1123 1124
		 "Template Creation Failure: $pid/$tid",
		 "Recursive error in cleanup! This is very bad.");
	$? = $saved_exitcode;
	return;
    }
    $cleaning = 1;
    cleanup();
    $? = $saved_exitcode;
}