libArchive.pm.in 37.6 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# All rights reserved.
#
# XXX Need to deal with locking at some point ...
#
package libArchive;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use lib '@prefix@/lib';
use libdb;
21
use libtestbed;
22 23 24 25 26 27 28 29
use English;
use File::stat;
use File::Basename;
use POSIX qw(strftime);
use Time::HiRes qw(gettimeofday);

# Configure variables
my $TB		= "@prefix@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30 31
my $MAINSITE    = @TBMAINSITE@;
my $ALLOWEDPID  = "testbed";
32 33 34 35 36 37 38 39 40 41
# XXX
my $ARCHIVEDIR  = "/usr/testbed/exparchive";
my $TESTMODE    = @TESTMODE@;
my $TBOPS       = "@TBOPSEMAIL@";
my $ELABINELAB  = @ELABINELAB@;
my $MD5		= "/sbin/md5";
my $MKDIR       = "/bin/mkdir";
my $CHMOD       = "/bin/chmod";
my $TAR		= "/usr/bin/tar";
my $RM		= "/bin/rm";
42 43 44
my $SVN         = "/usr/local/bin/svn";
my $SVNADMIN    = "/usr/local/bin/svnadmin";
my $IMPORTER    = "$TB/sbin/svn_load_dirs.pl";
45
my $inittag     = 'root';
46
my $defaultview = 'head';
47
my $debug       = 1;
48
my $svnopt      = ($debug ? "" : "-q");
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

    print STDERR "Running '$command'\n"
	if ($debug);
    system($command);
}

#
# Create a new archive. Returns -1 if any error. Otherwise return
# the new record index.
# 
64
sub ArchiveCreate(;$$)
65
{
66
    my ($tag, $view) = @_;
67
    
68 69
    my $idx;
    my $dir;
70 71 72

    $tag = $inittag
	if (!defined($tag));
73 74
    $view = $defaultview
	if (!defined($view));
75

76
    # Tags cannot must start with a letter.
77 78 79
    if ($tag =~ /^\d+/) {
	$tag = "T" . $tag;
    }
80 81 82 83 84

    #
    # Need to create the directory for it, once we have the index.
    # 
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
85
	DBQueryWarn("insert into archives set ".
86
		    "  idx=NULL, ".
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
		    "  date_created=UNIX_TIMESTAMP(now())");

    return -1
	if (!$query_result);

    $idx = $query_result->insertid;
    $dir = "$ARCHIVEDIR/$idx";

    #
    # Create the directory and store the absolute path into the new record.
    # This should probably be a privledged operation at some point.
    # 
    mysystem("$MKDIR $dir") == 0 or goto bad;
    mysystem("$CHMOD 775 $dir") == 0 or goto bad;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
102
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
103 104 105
	or goto bad;

    #
106
    # Make subdirs. One to hold the control tree, and the other
107 108
    # to hold currently checked out versions of the tree. Lastly, we
    # need a place to copyin files before they are added to the repo.
109
    #
110
    my $repodir   = "$dir/repo";
111 112
    my $checkouts = "$dir/checkouts";
    my $checkins  = "$dir/checkins";
113

114 115
    if (! mkdir("$repodir", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $repodir: $!\n";
116 117
	goto bad;
    }
118 119
    if (! chmod(0777, "$repodir")) {
	print STDERR "ArchiveCreate: Could not chmod $repodir: $!\n";
120 121
	goto bad;
    }
122 123
    if (! mkdir("$checkouts", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkouts: $!\n";
124 125
	goto bad;
    }
126 127
    if (! chmod(0777, "$checkouts")) {
	print STDERR "ArchiveCreate: Could not chmod $checkouts: $!\n";
128 129
	goto bad;
    }
130 131
    if (! mkdir("$checkins", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins: $!\n";
132 133
	goto bad;
    }
134 135 136 137 138 139 140 141 142 143
    if (! chmod(0777, "$checkins")) {
	print STDERR "ArchiveCreate: Could not chmod $checkins: $!\n";
	goto bad;
    }
    if (! mkdir("$checkins/$view", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins/$view: $!\n";
	goto bad;
    }
    if (! chmod(0777, "$checkins/$view")) {
	print STDERR "ArchiveCreate: Could not chmod $checkins/$view: $!\n";
144 145
	goto bad;
    }
146 147
    # Initialize the repo.
    mysystem("$SVNADMIN create $repodir") == 0
148
	or goto bad;
149 150 151 152
    
    # Create an stub directory tree and import it as "root"
    mysystem("cd $dir; mkdir ignore; cd ignore; mkdir $view; ".
             "         mkdir $view/trunk $view/savepoint $view/tags; ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153
	     "         mkdir $view/history; ".
154 155 156 157 158 159 160
	     "$SVN import -m 'ArchiveCreate' $view file://$repodir/$view")
	== 0 or goto bad;

    # Create a branch tag in the tags directory to base differences against.
    mysystem("$SVN copy -m 'ArchiveCreate Branch' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${tag}-branch")
161
	== 0 or goto bad;
162
    
163 164
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
165
	     "$SVN checkout $svnopt file://$repodir/$view")
166 167
	== 0 or goto bad;

168 169 170 171 172
    # Now enter the default view (okay, branch) of this archive.
    DBQueryWarn("insert into archive_views set ".
		"  current_tag='$tag', archive_idx='$idx', view='$view', ".
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
173
    # Now enter an initial tag for the tree. Nothing actually gets tagged.
174
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
175
		"  tag='$tag', archive_idx='$idx', ".
176 177 178 179 180 181 182
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
    return $idx;

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
183 184 185
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186
    DBQueryFatal("delete from archives where idx='$idx'")
187 188 189 190 191 192 193 194 195 196
	if (defined($idx));
    return -1;
}

#
# Add a file to an archive. Returns -1 if any error. Otherwise return 0.
# All this does is copy the file (and its directory structure) into the
# temporary store. Later, after all the files are in the tree, must
# commit it to the repo. 
#
197
sub ArchiveAdd($$;$)
198
{
199 200 201 202
    my ($archive_idx, $pathname, $view) = @_;

    $view = $defaultview
	if (!defined($view));
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228

    if (! -e $pathname || ! -r $pathname) {
	print STDERR "ArchiveFile: $pathname cannot be read!\n";
	return -1;
    }

    if (! -f $pathname) {
	print STDERR "ArchiveFile: $pathname must be a plain file!\n";
	return -1;
    }
    #
    # Check that the path does not contain an links to files outside
    # the directory space the user is allowed to access.
    #
    my $realpath = `realpath $pathname`;
    if ($realpath =~ /^([-\w\/\.\+\@,]+)$/) {
	$realpath = $1;
    }
    else {
	print STDERR "ArchiveFile: ".
	    "Bad data returned by realpath: $realpath\n";
    }
    #
    # The file must reside in /proj, /groups, or /users. 
    #
    if (! ($realpath =~ /^\/proj/) &&
229
	! ($realpath =~ /^\/share/) &&
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
	! ($realpath =~ /^\/groups/) &&
	! ($realpath =~ /^\/users/)) {
	print STDERR "ArchiveFile: ".
	    "$realpath does not resolve to an allowed directory!\n";
	return -1;
    }
    
    # Strip leading / from the pathname, and taint check it. 
    if ($pathname =~ /^[\/]+([-\w\/\.\+\@,]+)$/) {
	$pathname = $1;
    }
    else {
	print STDERR "ArchiveFile: Illegal characters in pathname $pathname\n";
	return -1;
    }

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveFile: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveFile: $directory cannot be written!\n";
	return -1;
    }
259
    my $repodir   = "$directory/repo";
260 261
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = "$directory/checkins/$view";
262 263 264 265 266
    
    #
    # See if the file is already in the archive. We currently deal with
    # just files; directories are gonna be a pain in the butt.
    #
267
    my $target_path = "$checkin/$pathname";
268 269 270 271 272 273

    #
    # The file should not already exist in the temporary store. 
    #
    if (-e $target_path) {
	print STDERR "ArchiveFile: ".
274
	    "WARNING: $pathname already exists in archive '$archive_idx'!\n";
275 276 277 278 279 280
    }

    #
    # Not in the archive. Copy the file in. We use tar cause we
    # want to retain the directory structure and mode bits, etc.
    #
281
    mysystem("$TAR cf - -C / $pathname | tar xf - -C $checkin");
282 283 284 285 286 287 288 289
    if ($?) {
	print STDERR "ArchiveFile: Could not copy in /$pathname\n";
	return -1;
    }
    return 0;
}

#
290 291 292 293 294
# Bring the current contents of the temporary store into the archive as a
# checkpoint (or a savepoint I guess). Implementationlly, its really a
# branch off the current import revision, since it does not become a new
# head revision until the entire branch (all the savepoints) is committed
# later, say when the experiment is swapped out.
295
#
296
sub ArchiveSavePoint($;$$)
297
{
298 299 300 301 302 303 304 305 306
    my ($archive_idx, $savetag, $view) = @_;
    my $cwd;

    $view = $defaultview
	if (!defined($view));

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
307 308 309 310 311 312

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
313
	print STDERR "ArchiveSavePoint: ".
314
	    "Archive '$archive_idx' does not exist in the DB!\n";
315
	goto bad;
316 317
    }
    if (! -d $directory || ! -w $directory) {
318
	print STDERR "ArchiveSavePoint: $directory cannot be written!\n";
319
	goto bad;
320
    }
321
    my $repodir   = "$directory/repo";
322 323
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = "$directory/checkins/$view";
324 325 326 327 328 329

    # Need to remember where we came from!
    chomp($cwd = `pwd`);
    # Must do the taint check too.
    if ($cwd =~ /^([-\w\.\/]+)$/) {
	$cwd = $1;
330
    }
331 332
    else {
	print STDERR "ArchiveSavePoint: Bad data in $cwd!\n";
333
	goto bad;
334 335
    }

336
    # Get the current tag for the archive.
337 338
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
339 340 341 342 343 344 345 346 347 348 349 350 351 352
	print STDERR "ArchiveSavePoint: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    # Make up a savetag if one not provided.
    if (!defined($savetag)) {
	my ($seconds, $microseconds) = gettimeofday();
	
	$savetag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
	$savetag .= $microseconds;
	$savetag .= "_savepoint";
    }

353
    # Tags must start with a letter.
354 355 356 357
    if ($savetag =~ /^\d+/) {
	$savetag = "T" . $savetag;
    }
    
358
    #
359
    # Use svn import command. This is nice cause it handles all the
360 361 362
    # subdirs and stuff in one shot, instead of trying to deal with
    # each file and directory individually.
    #
363 364 365 366
    if (! chdir("$checkin")) {
	print STDERR "ArchiveSavePoint: Cannot chdir to $checkin!\n";
	goto bad;
    }
367
    mysystem("$IMPORTER -no_user_input file://$repodir ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
368
	     "          $view/savepoint . ")
369 370 371 372 373 374 375 376 377 378
	== 0 or goto bad;

    #
    # Create the tag for this savepoint. 
    # 
    mysystem("$SVN copy -m 'ArchiveCreate Branch' ".
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;
    
379 380 381 382

    #
    # And record the new tag. 
    # 
383
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
384
		"  tag='$savetag', ".
385
		"  archive_idx='$archive_idx', ".
386
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
387

388
  okay:
389 390 391
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
392 393 394
    return 0;

  bad:
395 396 397
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
398 399 400 401 402 403 404
    return -1;
}

#
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
405
sub ArchiveCommit($;$$$)
406
{
407
    my ($archive_idx, $newtag, $view, $altdir) = @_;
408
    my $noactivity = 0;
409 410 411 412 413 414 415 416
    my $cwd;

    $view = $defaultview
	if (!defined($view));

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
417 418 419 420 421 422 423 424

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
425
	goto bad;
426 427 428
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
429
	goto bad;
430
    }
431
    my $repodir   = "$directory/repo";
432 433
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
434 435 436 437 438 439 440 441 442

    # Need to remember where we came from!
    chomp($cwd = `pwd`);
    # Must do the taint check too.
    if ($cwd =~ /^([-\w\.\/]+)$/) {
	$cwd = $1;
    }
    else {
	print STDERR "ArchiveSavePoint: Bad data in $cwd!\n";
443
	goto bad;
444 445
    }

446 447 448
    if (! chdir("$checkin")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkin!\n";
	goto bad;
449 450 451
    }

    # Get the current tags for the archive.
452
    my ($archive_tag, $previous_tag);
453
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
454
			      \$previous_tag) < 0) {
455 456 457 458 459 460
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
461 462
    # Form new tag.
    # 
463 464 465
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
466 467

    if (!defined($newtag)) {
468
	$newtag = $import_tag . "_commit";
469 470
    }

471
    # Tags cannot must start with a letter.
472 473 474
    if ($newtag =~ /^\d+/) {
	$newtag = "T" . $newtag;
    }
475

476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
    #
    # Lets see if there has been any action since the last commit.
    # Check for new tags, and if nothing has happened, just drop a
    # new set of tags in and return.
    #
    my $query_result =
	DBQueryWarn("select tag from archive_tags ".
		    "where archive_idx='$archive_idx' ".
		    "order by idx desc limit 1");
    goto bad
	if (!$query_result || !$query_result->numrows);
    
    my ($tmptag) = $query_result->fetchrow_array();
    if ($tmptag eq $archive_tag) {
	print "ArchiveCommit: Archive is clean; no need to commit.\n";
	$noactivity = 1;
    }
    
494
    # Clean the temp dir for next phase.
495
    mysystem("/bin/rm -rf $checkin/*");
496
    if ($?) {
497
	print STDERR "ArchiveCommit: Could not clean $checkin!\n";
498
	goto bad;
499 500 501
    }

    #
502 503 504
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
505
	#
506
	# Check out the current trunk.
507
	#
508 509 510
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

511
	#
512 513 514 515 516 517 518 519 520 521
	# Do a merge from the branch off the previous commit tag, with
	# the savepoint. This is merged into the working directory we
	# just checked out above. This will do the work of scheduling
	# additions and deletions.
	#
	mysystem("$SVN merge $svnopt ".
		 "     file://$repodir/$view/tags/${archive_tag}-branch ".
		 "     file://$repodir/$view/savepoint ".
		 "     trunk")
	    == 0 or goto bad;
522

523 524 525 526 527 528
	#
	# Now commit to the trunk!
	#
	mysystem("$SVN commit $svnopt ".
		 "     -m 'Commit merge of ${archive_tag} to trunk' trunk")
	    == 0 or goto bad;
529
    }
530

531 532 533 534 535 536
    # Create a tag in the tags directory for the commit.
    mysystem("$SVN copy -m 'ArchiveCommit' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}")
	== 0 or goto bad;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
537 538 539 540 541 542 543 544
    # Create a tag in the history directory for the commit. The
    # history directory has just the commit tags, so its easy to go
    # back in time.
    mysystem("$SVN copy -m 'ArchiveCommit' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/history/${newtag}")
	== 0 or goto bad;
    
545 546 547 548 549 550
    # Create a branch tag in the tags directory to base differences against.
    mysystem("$SVN copy -m 'ArchiveCommit Branch' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}-branch")
	== 0 or goto bad;
    
551
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
552
		"  tag='$newtag', ".
553
		"  archive_idx='$archive_idx', ".
554 555
		"  date_created=UNIX_TIMESTAMP(now())")
	or goto bad;
556

557
    DBQueryWarn("update archive_views set ".
558
		"  current_tag='$newtag', ".
559
		"  previous_tag='$archive_tag' ".
560 561
		"where archive_idx='$archive_idx' and view='$view'")
	or goto bad;
562 563

    # Clean the temp dir for later.
564
    mysystem("/bin/rm -rf $checkin/*");
565
    if ($?) {
566
	print STDERR "ArchiveCommit: Could not clean $checkin!\n";
567
	goto bad;
568 569
    }

570 571 572
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
573
	goto bad;
574
    }
575
    mysystem("$SVN $svnopt update trunk");
576
    if ($?) {
577
	print STDERR "ArchiveCommit: Could not update head revision!\n";
578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597
	goto bad;
    }
  okay:
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
    return 0;

  bad:
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
    return -1;
}

#
# Fork an archive (okay, branch) for use in separate development. Note that
# once forked, there is no join, as that would be impossibly hard to deal
# with cause of conflicts.
#
598
sub ArchiveFork($$;$$$)
599
{
600 601
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
602 603 604 605 606 607 608 609 610 611 612 613 614 615
    my $cwd;

    $view = $defaultview
	if (!defined($view));

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
616
	print STDERR "ArchiveCommit: ".
617 618 619 620 621
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
622
	goto bad;
623
    }
624
    my $repodir     = "$directory/repo";
625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642
    my $checkouts   = "$directory/checkouts";
    my $checkout    = "$directory/checkouts/$view";
    my $checkin     = "$directory/checkins/$view";
    my $newcheckout = "$directory/checkouts/$newview";
    my $newcheckin  = "$directory/checkins/$newview";

    # Need to remember where we came from!
    chomp($cwd = `pwd`);
    # Must do the taint check too.
    if ($cwd =~ /^([-\w\.\/]+)$/) {
	$cwd = $1;
    }
    else {
	print STDERR "ArchiveSavePoint: Bad data in $cwd!\n";
	goto bad;
    }

    # Get the current tags for the archive.
643
    my ($archive_tag, $previous_tag);
644
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
645
			      \$previous_tag) < 0) {
646 647 648 649 650
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666
    #
    # Form new tag.
    # 
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;

    if (!defined($newtag)) {
	$newtag = $import_tag . "_fork";
    }

    # Tags cannot must start with a letter.
    if ($newtag =~ /^\d+/) {
	$newtag = "T" . $newtag;
    }

667 668 669 670 671 672 673 674 675
    # Create new view directories and checkout.
    if (! mkdir("$newcheckin", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $newcheckin: $!\n";
	goto bad;
    }
    if (! chmod(0777, "$newcheckin")) {
	print STDERR "ArchiveCreate: Could not chmod $newcheckin: $!\n";
	goto bad;
    }
676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702

    # Create newview directory in the repo.
    mysystem("$SVN mkdir -m 'ArchiveFork' ".
	     "          file://$repodir/$newview")
	== 0 or goto bad;

    # Split at the trunk if no branchpoint provided.
    if (defined($branchtag)) {
	$sourcepoint = "tags/$branchtag";
    }
    else {
	$sourcepoint = "trunk"
    }

    # Copy the trunk of the old view.
    mysystem("$SVN copy $svnopt -m 'ArchiveFork' ".
	     "          file://$repodir/$view/$sourcepoint ".
	     "          file://$repodir/$newview/trunk")
	== 0 or goto bad;

    # Do not want to copy the tags/savepoints directories. Add new ones.
    mysystem("$SVN mkdir -m 'ArchiveFork' ".
	     "          file://$repodir/$newview/savepoint ".
	     "          file://$repodir/$newview/tags")
	== 0 or goto bad;

    # Now check it out. This creates the checkouts/$newview directory.
703
    mysystem("cd $checkouts; ".
704
	     "$SVN checkout $svnopt file://$repodir/$newview")
705 706
	== 0 or goto bad;

707 708 709 710 711
    # Now enter the newview (okay, branch) of this archive.
    DBQueryWarn("insert into archive_views set ".
		"  current_tag='$newtag', archive_idx='$archive_idx', ".
		"  view='$newview', ".
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
712
    
713 714 715 716
    # Now enter an initial tag for the new view. Nothing actually gets tagged.
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
		"  tag='$newtag', archive_idx='$archive_idx', ".
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
717

718
  okay:
719 720 721
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
722
    return 0;
723 724

  bad:
725 726 727
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
728
    return -1;
729 730
}

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 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812
#
# Checkout a copy of the archive, optionally at a particular view/branch.
#
sub ArchiveCheckout($$;$$)
{
    my ($archive_idx, $target, $view, $tag) = @_;
    my $sourcepoint;
    my $cwd;

    $view = $defaultview
	if (!defined($view));

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveCheckout: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCheckout: $directory cannot be written!\n";
	goto bad;
    }
    my $repodir     = "$directory/repo";

    #
    # We allow target to exist or not exist.
    #
    if (! -e $target) {
	if (! mkdir("$target", 0777)) {
	    print STDERR "ArchiveCheckout: Could not mkdir $target: $!\n";
	    return -1;
	}
	if (! chmod(0777, "$target")) {
	    print STDERR "ArchiveCheckout: ".
		"Could not chmod directory $target: $!\n";
	    return -1;
	}
    }

    # Need to remember where we came from!
    chomp($cwd = `pwd`);
    # Must do the taint check too.
    if ($cwd =~ /^([-\w\.\/]+)$/) {
	$cwd = $1;
    }
    else {
	print STDERR "ArchiveCheckout: Bad data in $cwd!\n";
	goto bad;
    }

    # Where to find what we want.
    if (defined($tag)) {
	$sourcepoint = "tags/$tag";
    }
    else {
	$sourcepoint = "trunk"
    }

    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $target; ".
	     "$SVN checkout $svnopt file://$repodir/$view/$sourcepoint .")
	== 0 or goto bad;
  okay:
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
    return 0;

  bad:
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
    return -1;
}

813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
#
# Archive the Archive, moving it into the expinfo directory.
# I intend this to be run only when an experiment is terminated.
# No need to have two copies.
#
sub ArchiveArchive($$)
{
    my ($archive_idx, $dirpath) = @_;
    my $target = "$dirpath/Archive";

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveFile: $directory cannot be written!\n";
	return -1;
    }

    if (! -e $target) {
	if (! mkdir("$target", 0777)) {
	    print STDERR "ArchiveArchive: Could not mkdir $target: $!\n";
	    return -1;
	}
	if (! chmod(0777, "$target")) {
	    print STDERR "ArchiveArchive: ".
		"Could not chmod directory $target: $!\n";
	    return -1;
	}
    }    

    #
    # Tar up the whole thing and move it across.
    #
852
    mysystem("$TAR cf - -C $directory repo | tar xf - -C $target");
853 854 855 856
    if ($?) {
	print STDERR "ArchiveArchive: Could not copy in $directory\n";
	return -1;
    }
857 858 859 860 861 862 863 864 865 866 867 868 869 870

    #
    # Update its location in the DB, and remove the old directory.
    # 
    DBQueryWarn("update archives set directory='$target' ".
		"where idx='$archive_idx'")
	or return -1;
    
    mysystem("/bin/rm -rf $directory");
    if ($?) {
	print STDERR "ArchiveArchive: ".
	    "Could not remove contents of $directory!\n";
	return -1;
    }
871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903
    return 0;
}

#
# Destroy an archive. The DB state is retained unless optional flag says
# to clean it.
#
sub ArchiveDestroy($;$)
{
    my ($archive_idx, $clean) = @_;

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveDestroy: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
	return 0;
    }

    mysystem("/bin/rm -rf $directory");
    if ($?) {
	print STDERR "ArchiveDestroy: ".
	    "Could not remove contents of $directory!\n";
	return -1;
    }
    if (defined($clean) && $clean) {
	(DBQueryWarn("delete from archive_tags ".
		     "where archive_idx='$archive_idx'") &&
904 905
	 DBQueryWarn("delete from archive_views ".
		     "where archive_idx='$archive_idx'") &&
Leigh B. Stoller's avatar
Leigh B. Stoller committed
906
	 DBQueryWarn("delete from archives ".
907 908 909 910 911 912 913 914 915 916 917 918 919 920
		     "where idx='$archive_idx'")) || return -1;
    }
    return 0;
}

#
# Get the directory for an archive, given its index. Returns -1 on error,
# zero otherwise. 
#
sub GetArchiveDirectory($$)
{
    my ($idx, $rvalp) = @_;
    
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
921
	DBQueryWarn("select directory from archives where idx='$idx'");
922 923 924 925 926 927 928 929 930 931 932 933 934 935

    return -1
	if (!$query_result || !$query_result->numrows);
    my ($dir) = $query_result->fetchrow_array();

    $$rvalp = $dir
	if (defined($rvalp));
    return 0;
}

#
# Get the current tag for an archive, given its index. Returns -1 on error,
# zero otherwise. Place tag in the return pointer.
#
936
sub GetArchiveCurrentTags($$$;$)
937
{
938
    my ($archive_idx, $view, $tagp, $prevp) = @_;
939 940
    
    my $query_result =
941
	DBQueryWarn("select v.current_tag,v.previous_tag ".
942 943 944 945 946 947
		    "    from archive_views as v ".
		    "left join archive_tags as t on ".
		    "     t.archive_idx=v.archive_idx and ".
		    "     t.tag=v.current_tag ".
		    "where v.archive_idx='$archive_idx' and ".
		    "      v.view='$view'");
948 949 950

    return -1
	if (!$query_result);
951
    my ($tag,$previous) = $query_result->fetchrow_array();
952
    
953 954 955 956
    $$tagp = $tag
	if (defined($tagp));
    $$prevp = $previous
	if (defined($prevp));
957 958 959 960 961 962 963 964
    return 0;
}

#
# Get the archive index for an experiment. The index is kept in the historical
# experiment_stats table, not the current experiments table. That is cause
# we keep the archive and its DB info around forever with the stats.
#
965
sub TBExperimentArchiveInfo($$$$)
966
{
967
    my ($pid, $eid, $idxp, $viewp) = @_;
968 969

    my $query_result =
970
	DBQueryWarn("select s.archive_idx,e.idx from experiments as e ".
971 972 973 974 975 976
		    "left join experiment_stats as s on s.exptidx=e.idx ".
		    "where e.pid='$pid' and e.eid='$eid'");

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

977
    my ($archive_idx,$exptidx) = $query_result->fetchrow_array();
978

979 980 981
    # Need to deal with no archive yet!
    return 1
	if (!defined($archive_idx) || $archive_idx == 0);
982 983 984 985 986

    $$idxp = $archive_idx
	if (defined($idxp));
    $$viewp = "$exptidx"
	if (defined($viewp));
987
    
988
    return 0;
989 990 991 992 993 994 995 996 997 998 999 1000 1001
}

#
# Create a new archive for an experiment. This has to update the
# experiment_stats table with the newly created archive index.
# Then we have to set the current tag for the experiment in the
# resources table for the experiment.
# Returns zero on success, -1 on failure.
#
sub TBCreateExperimentArchive($$)
{
    my ($pid, $eid) = @_;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1002 1003 1004
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1005 1006 1007 1008 1009 1010 1011 1012 1013 1014
    # Grab experiment indicies we need,
    my $query_result =
	DBQueryWarn("select e.idx,s.rsrcidx from experiments as e ".
		    "left join experiment_stats as s on e.idx=s.exptidx ".
		    "where e.pid='$pid' and e.eid='$eid'");
    if (!$query_result || !$query_result->numrows) {
	return -1;
    }

    my ($exptidx,$rsrcidx) = $query_result->fetchrow_array();
1015 1016 1017 1018 1019
    my $archive_tag = "T${rsrcidx}";

    #
    # Create the new archive and get back the new index. 
    #
1020
    my $archive_idx = ArchiveCreate($archive_tag, "$exptidx");
1021 1022
    return -1
	if ($archive_idx < 0);
1023 1024 1025 1026 1027 1028

    if (! (DBQueryWarn("update experiment_stats set ".
		       "      archive_idx='$archive_idx' ".
		       "where pid='$pid' and eid='$eid' and ".
		       "      exptidx='$exptidx'") &&
	   DBQueryWarn("update experiment_resources set ".
1029
		       "      archive_tag='$archive_tag' ".
1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042
		       "where idx='$rsrcidx'"))) {
	ArchiveDestroy($archive_idx, 1);
	return -1;
    }
    return 0;
}

#
# Add a file to an experiment archive.
#
sub TBExperimentArchiveAddFile($$$)
{
    my ($pid, $eid, $pathname) = @_;
1043
    my ($archive_idx, $view);
1044

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1045 1046 1047
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1048 1049 1050
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1051
    return -1
1052
	if ($rval < 0);
1053

1054
    return ArchiveAdd($archive_idx, $pathname, $view);
1055 1056
}

1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098
#
# Add files picked up by NFS tracing to an experiment archive.
#
sub TBExperimentArchiveAddTracedFiles($$)
{
    my ($pid, $eid) = @_;
    my ($archive_idx, $view);

    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
    return -1
	if ($rval < 0);

    my $query_result =
	DBQueryFatal("SELECT e.idx,s.rsrcidx FROM experiments as e ".
		     "left join experiment_stats as s on e.idx=s.exptidx ".
		     "where e.pid='$pid' and e.eid='$eid'");
    
    if ($query_result->num_rows() != 1) {
	die("*** $0:\n".
	    "    Experiment $pid/$eid has no stats!\n");
    }
    my ($exptidx, $rsrcidx) = $query_result->fetchrow_array();

    $query_result = 
	DBQueryFatal("SELECT af.fn FROM fs_resources as fr ".
		     "LEFT JOIN accessed_files as af on af.idx=fr.fileidx ".
		     "WHERE fr.rsrcidx=$rsrcidx and fr.type!='l'");
    while (my ($fn) = $query_result->fetchrow_array()) {
	$rval = ArchiveAdd($archive_idx, $fn, $view);

	return $rval
	    if ($rval != 0);
    }

    return 0;
}

1099
#
1100
# SavePoint an experiment archive. 
1101
#
1102 1103 1104
sub TBExperimentArchiveSavePoint($$$)
{
    my ($pid, $eid, $tagext) = @_;
1105
    my ($archive_idx, $view);
1106

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1107 1108 1109
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1110 1111 1112
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1113
    return -1
1114
	if ($rval < 0);
1115 1116

    #
1117
    # Derive a tag that contains some useful info?
1118 1119 1120 1121 1122 1123
    #
    my ($seconds, $microseconds) = gettimeofday();
    my $newtag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $newtag .= int($microseconds / 1000);
    $newtag .= "_${tagext}";

1124
    return ArchiveSavePoint($archive_idx, $newtag, $view);
1125 1126 1127 1128 1129 1130 1131 1132
}

#
# Setup for a swapmod. A pain in the butt!
#
sub TBExperimentArchivePreSwapMod($$)
{
    my ($pid, $eid) = @_;
1133
    my ($archive_idx, $view);
1134

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1135 1136 1137
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1138 1139 1140
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1141
    return -1
1142
	if ($rval < 0);
1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153

    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchivePreSwapMod: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchivePreSwapMod: $directory cannot be written!\n";
	return -1;
    }
1154 1155
    my $checkin    = "$directory/checkins/$view";
    my $preswapdir = "${checkin}.preswap";
1156 1157

    #
1158
    # Derive a tag that says something useful?
1159 1160 1161 1162 1163 1164 1165 1166 1167 1168
    #
    my ($seconds, $microseconds) = gettimeofday();
    my $newtag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $newtag .= int($microseconds / 1000);
    $newtag .= "_preswapmod";

    #
    # Do a savepoint just for grins,
    #
    return -1
1169
	if (ArchiveSavePoint($archive_idx, $newtag, $view) != 0);
1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192

    #
    # Make a copy of the current tree, since its easier to rollback
    # if I just wait before doing a commit (until swapmod really finishes).
    #
    if (-e $preswapdir) {
	system("/bin/rm -rf $preswapdir");
	if (-e $preswapdir) {
	    print STDERR
		"ArchivePreSwapMod: Could not delete old preswap dir!\n";
	    return -1;
	}
    }
    if (! mkdir("$preswapdir", 0777)) {
	print STDERR "ArchivePreSwapMod: Could not mkdir $preswapdir: $!\n";
	return -1;
    }
    if (! chmod(0777, "$preswapdir")) {
	print STDERR "ArchivePreSwapMod: ".
	    "Could not chmod directory $preswapdir: $!\n";
	goto bad;
    }
    
1193
    mysystem("$TAR cf - -C $checkin . | tar xf - -C $preswapdir");
1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217
    if ($?) {
	print STDERR "ArchivePreSwapMod: Could not copy to $preswapdir\n";
	goto bad;
    }
    return 0;

  bad:
    # Be sure to remove the new directory!
    if (-e $preswapdir) {
	system("/bin/rm -rf $preswapdir");
	if (-e $preswapdir) {
	    print STDERR
		"ArchivePreSwapMod: Could not delete new preswap dir!\n";
	}
    }
    return -1;
}

#
# Rollback from a failed swapmod.
#
sub TBExperimentArchiveRollBack($$)
{
    my ($pid, $eid) = @_;
1218
    my ($archive_idx, $view);
1219

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1220 1221 1222
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1223 1224 1225
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1226
    return -1
1227
	if ($rval < 0);
1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238

    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
	print STDERR "ArchiveRollBack: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveRollBack: $directory cannot be written!\n";
	return -1;
    }
1239 1240
    my $checkin    = "$directory/checkins/$view";
    my $preswapdir = "${checkin}.preswap";
1241 1242 1243 1244 1245 1246 1247 1248

    # In case we bailed out really early in the swapmod path.
    return 0
	if (! -e $preswapdir);

    #
    # Restore the old (preswap) tree to the current tree.
    #
1249 1250 1251
    if (-e $checkin) {
	system("/bin/rm -rf $checkin");
	if (-e $checkin) {
Leigh B. Stoller's avatar