libArchive.pm.in 41.9 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
# 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";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
41
my $RSYNC	= "/usr/local/bin/rsync";
42
my $RM		= "/bin/rm";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
my $REALPATH	= "/bin/realpath";
44 45 46
my $SVN         = "/usr/local/bin/svn";
my $SVNADMIN    = "/usr/local/bin/svnadmin";
my $IMPORTER    = "$TB/sbin/svn_load_dirs.pl";
47
my $inittag     = 'root';
48
my $defaultview = 'head';
49
my $debug       = 1;
50
my $svnopt      = ($debug ? "" : "-q");
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

# 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.
# 
66
sub ArchiveCreate(;$$)
67
{
68
    my ($tag, $view) = @_;
69
    
70 71
    my $idx;
    my $dir;
72 73 74

    $tag = $inittag
	if (!defined($tag));
75 76
    $view = $defaultview
	if (!defined($view));
77

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

    #
    # Need to create the directory for it, once we have the index.
    # 
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
87
	DBQueryWarn("insert into archives set ".
88
		    "  idx=NULL, ".
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
		    "  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
104
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
105 106 107
	or goto bad;

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

116 117
    if (! mkdir("$repodir", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $repodir: $!\n";
118 119
	goto bad;
    }
120 121
    if (! chmod(0777, "$repodir")) {
	print STDERR "ArchiveCreate: Could not chmod $repodir: $!\n";
122 123
	goto bad;
    }
124 125
    if (! mkdir("$checkouts", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkouts: $!\n";
126 127
	goto bad;
    }
128 129
    if (! chmod(0777, "$checkouts")) {
	print STDERR "ArchiveCreate: Could not chmod $checkouts: $!\n";
130 131
	goto bad;
    }
132 133
    if (! mkdir("$checkins", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins: $!\n";
134 135
	goto bad;
    }
136 137 138 139 140 141 142 143 144 145
    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";
146 147
	goto bad;
    }
148 149
    # Initialize the repo.
    mysystem("$SVNADMIN create $repodir") == 0
150
	or goto bad;
151 152 153 154
    
    # 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
155
	     "         mkdir $view/history; ".
156 157 158 159 160 161 162
	     "$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")
163
	== 0 or goto bad;
164
    
165 166
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
167
	     "$SVN checkout $svnopt file://$repodir/$view")
168 169
	== 0 or goto bad;

170 171 172 173 174
    # 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;
    
175
    # Now enter an initial tag for the tree. Nothing actually gets tagged.
176
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
177
		"  tag='$tag', archive_idx='$idx', ".
178 179 180 181 182 183 184
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
    return $idx;

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
185 186 187
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
188
    DBQueryFatal("delete from archives where idx='$idx'")
189 190 191 192 193 194 195 196 197 198
	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. 
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
199
sub ArchiveAdd($$;$$)
200
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
201
    my ($archive_idx, $pathname, $view, $exact) = @_;
202 203 204

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
206 207 208
    $exact = 0
	if (!defined($exact));

209 210 211 212 213 214 215 216 217
    if (! -e $pathname || ! -r $pathname) {
	print STDERR "ArchiveFile: $pathname cannot be read!\n";
	return -1;
    }

    #
    # Check that the path does not contain an links to files outside
    # the directory space the user is allowed to access.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
218
    my $realpath = `$REALPATH $pathname`;
219 220 221 222 223 224 225 226 227 228 229
    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/) &&
230
	! ($realpath =~ /^\/share/) &&
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 259
	! ($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;
    }
260
    my $repodir   = "$directory/repo";
261 262
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = "$directory/checkins/$view";
263 264
    
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
265 266 267 268
    # Copy the file in. We use tar on individual files (to retain the
    # directory structure and mode bits, etc). On a directory, use either
    # tar or rsync, depending on whether we want an exact copy (removing
    # files in the target that are not present in the source). 
269
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
270 271 272 273 274
    if (-f "/${pathname}" || !$exact) {
	mysystem("$TAR cf - -C / $pathname | tar xf - -C $checkin");
    }
    else {
	mysystem("$RSYNC -R -avx --delete /${pathname} $checkin");
275 276 277 278 279 280 281 282 283
    }
    if ($?) {
	print STDERR "ArchiveFile: Could not copy in /$pathname\n";
	return -1;
    }
    return 0;
}

#
284 285 286 287 288
# 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.
289
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
290
sub ArchiveSavePoint($;$$$)
291
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
292
    my ($archive_idx, $savetag, $view, $altdir) = @_;
293 294 295 296 297 298 299 300
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
301 302 303 304 305 306

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
307
	print STDERR "ArchiveSavePoint: ".
308
	    "Archive '$archive_idx' does not exist in the DB!\n";
309
	goto bad;
310 311
    }
    if (! -d $directory || ! -w $directory) {
312
	print STDERR "ArchiveSavePoint: $directory cannot be written!\n";
313
	goto bad;
314
    }
315
    my $repodir   = "$directory/repo";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
316
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
317 318 319 320 321 322

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

329
    # Get the current tag for the archive.
330 331
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
332 333 334 335 336 337 338 339 340 341 342 343 344 345
	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";
    }

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

    #
    # And record the new tag. 
    # 
376
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
377
		"  tag='$savetag', ".
378
		"  archive_idx='$archive_idx', ".
379
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
380

381
  okay:
382 383 384
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
385 386 387
    return 0;

  bad:
388 389 390
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
391 392 393 394 395 396 397
    return -1;
}

#
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
398
sub ArchiveCommit($;$$$)
399
{
400
    my ($archive_idx, $newtag, $view, $altdir) = @_;
401
    my $noactivity = 0;
402 403 404 405 406 407 408 409
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
410 411 412 413 414 415 416 417

    #
    # 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";
418
	goto bad;
419 420 421
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
422
	goto bad;
423
    }
424
    my $repodir   = "$directory/repo";
425 426
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
427 428 429 430 431 432 433 434

    # Need to remember where we came from!
    chomp($cwd = `pwd`);
    # Must do the taint check too.
    if ($cwd =~ /^([-\w\.\/]+)$/) {
	$cwd = $1;
    }
    else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
435
	print STDERR "ArchiveCommit: Bad data in $cwd!\n";
436
	goto bad;
437 438
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
439 440
    if (! chdir("$directory")) {
	print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
441
	goto bad;
442 443 444
    }

    # Get the current tags for the archive.
445
    my ($archive_tag, $previous_tag);
446
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
447
			      \$previous_tag) < 0) {
448 449 450 451 452 453
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
454 455
    # Form new tag.
    # 
456 457 458
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
459 460

    if (!defined($newtag)) {
461
	$newtag = $import_tag . "_commit";
462 463
    }

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

469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
    #
    # 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;
    }
    
487
    #
488 489 490
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
491 492 493 494 495 496 497 498 499
	#
	# Create a temporary spot to work in.
	# 
	if (! mkdir("merge.$$", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
	    goto bad;
	}
	chdir("merge.$$");
	
500
	#
501
	# Check out the current trunk.
502
	#
503 504 505
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

506
	#
507 508 509 510 511 512 513 514 515 516
	# 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;
517

518 519 520 521 522 523
	#
	# Now commit to the trunk!
	#
	mysystem("$SVN commit $svnopt ".
		 "     -m 'Commit merge of ${archive_tag} to trunk' trunk")
	    == 0 or goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
524 525 526 527 528 529 530

	# Clean the temp dir,
	chdir("$directory");
	mysystem("/bin/rm -rf merge.$$");
	if ($?) {
	    print STDERR "ArchiveCommit: Could not remove merge.$$\n";
	}
531
    }
532

533 534 535 536 537 538
    # 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
539 540 541 542 543 544 545 546
    # 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;
    
547 548 549 550 551 552
    # 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;
    
553
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
554
		"  tag='$newtag', ".
555
		"  archive_idx='$archive_idx', ".
556 557
		"  date_created=UNIX_TIMESTAMP(now())")
	or goto bad;
558

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

    # Clean the temp dir for later.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
   if (0) {
    if (!defined($altdir)) {
	mysystem("/bin/rm -rf $checkin");
	if ($?) {
	    print STDERR "ArchiveCommit: Could not remove $checkin!\n";
	    goto bad;
	}
	if (! mkdir("$checkin", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir $checkin: $!\n";
	    goto bad;
	}
	if (! chmod(0777, "$checkin")) {
	    print STDERR "ArchiveCommit: Could not chmod $checkin: $!\n";
	    goto bad;
	}
581
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
582
   }
583

584 585 586
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
587
	goto bad;
588
    }
589
    mysystem("$SVN $svnopt update trunk");
590
    if ($?) {
591
	print STDERR "ArchiveCommit: Could not update head revision!\n";
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611
	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.
#
612
sub ArchiveFork($$;$$$)
613
{
614 615
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
616 617 618 619 620 621 622 623 624 625 626 627 628 629
    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) {
630
	print STDERR "ArchiveCommit: ".
631 632 633 634 635
	    "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";
636
	goto bad;
637
    }
638
    my $repodir     = "$directory/repo";
639 640 641 642 643 644 645 646 647 648 649 650 651
    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 {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
652
	print STDERR "ArchiveFork: Bad data in $cwd!\n";
653 654 655 656
	goto bad;
    }

    # Get the current tags for the archive.
657
    my ($archive_tag, $previous_tag);
658
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
659
			      \$previous_tag) < 0) {
660 661 662 663 664
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680
    #
    # 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;
    }

681 682 683 684 685 686 687 688 689
    # 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;
    }
690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716

    # 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.
717
    mysystem("cd $checkouts; ".
718
	     "$SVN checkout $svnopt file://$repodir/$newview")
719 720
	== 0 or goto bad;

721 722 723 724 725
    # 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;
726
    
727 728 729 730
    # 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;
731

732
  okay:
733 734 735
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
736
    return 0;
737 738

  bad:
739 740 741
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
742
    return -1;
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 813 814 815 816 817 818 819 820 821 822 823 824 825 826
#
# 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;
}

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 852 853 854 855 856 857 858 859 860 861 862 863 864 865
#
# 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.
    #
866
    mysystem("$TAR cf - -C $directory repo | tar xf - -C $target");
867 868 869 870
    if ($?) {
	print STDERR "ArchiveArchive: Could not copy in $directory\n";
	return -1;
    }
871 872 873 874 875 876 877 878 879 880 881 882 883 884

    #
    # 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;
    }
885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917
    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'") &&
918 919
	 DBQueryWarn("delete from archive_views ".
		     "where archive_idx='$archive_idx'") &&
Leigh B. Stoller's avatar
Leigh B. Stoller committed
920
	 DBQueryWarn("delete from archives ".
921 922 923 924 925 926 927 928 929 930 931 932 933 934
		     "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
935
	DBQueryWarn("select directory from archives where idx='$idx'");
936 937 938 939 940 941 942 943 944 945 946 947 948 949

    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.
#
950
sub GetArchiveCurrentTags($$$;$)
951
{
952
    my ($archive_idx, $view, $tagp, $prevp) = @_;
953 954
    
    my $query_result =
955
	DBQueryWarn("select v.current_tag,v.previous_tag ".
956 957 958 959 960 961
		    "    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'");
962 963 964

    return -1
	if (!$query_result);
965
    my ($tag,$previous) = $query_result->fetchrow_array();
966
    
967 968 969 970
    $$tagp = $tag
	if (defined($tagp));
    $$prevp = $previous
	if (defined($prevp));
971 972 973 974 975 976 977 978
    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.
#
979
sub TBExperimentArchiveInfo($$$$)
980
{
981
    my ($pid, $eid, $idxp, $viewp) = @_;
982 983

    my $query_result =
984
	DBQueryWarn("select s.archive_idx,e.idx from experiments as e ".
985 986 987 988 989 990
		    "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);

991
    my ($archive_idx,$exptidx) = $query_result->fetchrow_array();
992

993 994 995
    # Need to deal with no archive yet!
    return 1
	if (!defined($archive_idx) || $archive_idx == 0);
996 997 998 999 1000

    $$idxp = $archive_idx
	if (defined($idxp));
    $$viewp = "$exptidx"
	if (defined($viewp));
1001
    
1002
    return 0;
1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015
}

#
# 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
1016 1017 1018
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1019 1020 1021 1022 1023 1024 1025 1026 1027 1028
    # 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();
1029 1030 1031 1032 1033
    my $archive_tag = "T${rsrcidx}";

    #
    # Create the new archive and get back the new index. 
    #
1034
    my $archive_idx = ArchiveCreate($archive_tag, "$exptidx");
1035 1036
    return -1
	if ($archive_idx < 0);
1037 1038 1039 1040 1041 1042

    if (! (DBQueryWarn("update experiment_stats set ".
		       "      archive_idx='$archive_idx' ".
		       "where pid='$pid' and eid='$eid' and ".
		       "      exptidx='$exptidx'") &&
	   DBQueryWarn("update experiment_resources set ".
1043
		       "      archive_tag='$archive_tag' ".
1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056
		       "where idx='$rsrcidx'"))) {
	ArchiveDestroy($archive_idx, 1);
	return -1;
    }
    return 0;
}

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1059 1060 1061
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1062 1063 1064
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1065
    return -1
1066
	if ($rval < 0);
1067

1068
    return ArchiveAdd($archive_idx, $pathname, $view);
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 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112
#
# 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;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141
#
# Add files the user explicitly wants archived
#
sub TBExperimentArchiveAddUserFiles($$)
{
    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 $userdir  = TBExptUserDir($pid, $eid);
    my $userarch = "$userdir/archive";

    if (-e $userarch) {
	$rval = ArchiveAdd($archive_idx, $userarch, $view, 1);

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

1142
#
1143
# SavePoint an experiment archive. 
1144
#
1145 1146 1147
sub TBExperimentArchiveSavePoint($$$)
{
    my ($pid, $eid, $tagext) = @_;
1148
    my ($archive_idx, $view);
1149

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1150 1151 1152
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1153 1154 1155
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1156
    return -1
1157
	if ($rval < 0);
1158 1159

    #
1160
    # Derive a tag that contains some useful info?
1161 1162 1163 1164 1165 1166
    #
    my ($seconds, $microseconds) = gettimeofday();
    my $newtag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $newtag .= int($microseconds / 1000);
    $newtag .= "_${tagext}";

1167
    return ArchiveSavePoint($archive_idx, $newtag, $view);
1168 1169 1170 1171 1172 1173 1174 1175
}

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1178 1179 1180
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1181 1182 1183
    my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
    return 0
	if ($rval > 0);
1184
    return -1
1185
	if ($rval < 0);
1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196

    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;
    }
1197
    my $checkin    = "$directory/checkins/$view";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1198
    my $preswapdir = "${checkin}.preswapmod";
1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221

    #
    # 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;
    }
    
1222
    mysystem("$TAR cf - -C $checkin . | tar xf - -C $preswapdir");
1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240
    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;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292