libArchive.pm.in 44.9 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
Timothy Stack's avatar
Timothy Stack committed
4
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
# 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
# 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";
40
my $CHGRP       = "/usr/bin/chgrp";
41
my $TAR		= "/usr/bin/tar";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42
my $RSYNC	= "/usr/local/bin/rsync";
43
my $RM		= "/bin/rm";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
my $REALPATH	= "/bin/realpath";
45 46 47
my $SVN         = "/usr/local/bin/svn";
my $SVNADMIN    = "/usr/local/bin/svnadmin";
my $IMPORTER    = "$TB/sbin/svn_load_dirs.pl";
48
my $inittag     = 'root';
49
my $defaultview = 'head';
50
my $debug       = 0;
51
my $svnopt      = ($debug ? "" : "-q");
52 53 54 55
my %ROOTS       = ("proj"   => "proj",
		   "users"  => "users",
		   "share"  => "share",
		   "groups" => "groups");
56 57 58 59 60 61 62 63 64 65 66

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

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

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
# Another little helper for scripts that include this library.
sub setdebug($)
{
    my ($toggle) = @_;

    if ($toggle) {
	$debug  = 1;
	$svnopt = "";
    }
    else {
	$debug  = 0;
	$svnopt = "-q";
    }
}

82 83 84 85
#
# Create a new archive. Returns -1 if any error. Otherwise return
# the new record index.
# 
86
sub ArchiveCreate(;$$$)
87
{
88
    my ($tag, $view, $unix_gid) = @_;
89
    
90 91
    my $idx;
    my $dir;
92 93 94

    $tag = $inittag
	if (!defined($tag));
95 96
    $view = $defaultview
	if (!defined($view));
97

98
    # Tags cannot must start with a letter.
99 100 101
    if ($tag =~ /^\d+/) {
	$tag = "T" . $tag;
    }
102 103 104 105 106

    #
    # Need to create the directory for it, once we have the index.
    # 
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107
	DBQueryWarn("insert into archives set ".
108
		    "  idx=NULL, ".
109 110 111 112 113 114 115 116 117 118 119 120 121 122
		    "  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;
123 124 125
    if (defined($unix_gid)) {
	mysystem("$CHGRP $unix_gid $dir") == 0 or goto bad;
    }
126

Leigh B. Stoller's avatar
Leigh B. Stoller committed
127
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
128 129 130
	or goto bad;

    #
131
    # Make subdirs. One to hold the control tree, and the other
132 133
    # to hold currently checked out versions of the tree. Lastly, we
    # need a place to copyin files before they are added to the repo.
134
    #
135
    my $repodir   = "$dir/repo";
136 137
    my $checkouts = "$dir/checkouts";
    my $checkins  = "$dir/checkins";
138

139 140
    if (! mkdir("$repodir", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $repodir: $!\n";
141 142
	goto bad;
    }
143 144
    if (! chmod(0777, "$repodir")) {
	print STDERR "ArchiveCreate: Could not chmod $repodir: $!\n";
145 146
	goto bad;
    }
147 148
    if (! mkdir("$checkouts", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkouts: $!\n";
149 150
	goto bad;
    }
151 152
    if (! chmod(0777, "$checkouts")) {
	print STDERR "ArchiveCreate: Could not chmod $checkouts: $!\n";
153 154
	goto bad;
    }
155 156
    if (! mkdir("$checkins", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins: $!\n";
157 158
	goto bad;
    }
159 160 161 162 163 164 165 166 167 168
    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";
169 170
	goto bad;
    }
171 172
    # Initialize the repo.
    mysystem("$SVNADMIN create $repodir") == 0
173
	or goto bad;
174 175 176 177
    
    # 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
178
	     "         mkdir $view/history; ".
Timothy Stack's avatar
Timothy Stack committed
179
	     "$SVN import $svnopt -m 'ArchiveCreate' ".
180
	     "     $view file://$repodir/$view")
181 182 183
	== 0 or goto bad;

    # Create a branch tag in the tags directory to base differences against.
184
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
185 186
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${tag}-branch")
187
	== 0 or goto bad;
188
    
189 190
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
191
	     "$SVN checkout $svnopt file://$repodir/$view")
192 193
	== 0 or goto bad;

194 195 196 197 198
    # 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;
    
199
    # Now enter an initial tag for the tree. Nothing actually gets tagged.
200
    DBQueryWarn("insert into archive_tags set idx=NULL, view='$view', ".
201
		"  tag='$tag', archive_idx='$idx', ".
202 203 204 205 206 207 208
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
    return $idx;

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
209 210 211
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
212
    DBQueryFatal("delete from archives where idx='$idx'")
213 214 215 216 217 218 219 220 221 222
	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
223
sub ArchiveAdd($$;$$)
224
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
225
    my ($archive_idx, $pathname, $view, $exact) = @_;
226
    my $rootdir;
227 228 229

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
231 232 233
    $exact = 0
	if (!defined($exact));

234 235 236 237 238 239 240 241 242
    # Taint check path before handing off to shell below.
    if ($pathname =~ /^([-\w\/\.\+\@,~]+)$/) {
	$pathname = $1;
    }
    else {
	print STDERR "ArchiveAdd: ".
	    "Illegal characters in: $pathname\n";
    }

243
    if (! -e $pathname || ! -r $pathname) {
244
	print STDERR "*** ArchiveAdd: $pathname cannot be read!\n";
245
	return 0;
246 247 248
    }

    #
249 250
    # Use realpath to check that the path does not contain links to
    # files outside the directory space the user is allowed to access.
251
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252
    my $realpath = `$REALPATH $pathname`;
253
    if ($realpath =~ /^([-\w\/\.\+\@,~]+)$/) {
254 255 256
	$realpath = $1;
    }
    else {
257
	print STDERR "ArchiveAdd: ".
258 259
	    "Bad data returned by realpath: $realpath\n";
    }
260

261
    #
262 263
    # Strip leading /dir from the pathname, and taint check it. We want
    # a relative path to the rootdiir so we can copy it in. 
264
    #
265 266 267
    if ($realpath =~ /^[\/]+(\w+)\/([-\w\/\.\+\@,~]+)$/) {
	$rootdir  = $1;
	$pathname = $2;
268 269
    }
    else {
270 271 272 273 274 275 276 277 278 279
	print STDERR "ArchiveAdd: Illegal characters in pathname $pathname\n";
	return -1;
    }

    #
    # The file must reside in one of the Emulab "root" filesystems.
    #
    if (! exists($ROOTS{$rootdir})) {
	print STDERR "ArchiveAdd: ".
	    "$realpath does not resolve to an allowed directory!\n";
280 281 282 283 284 285 286 287
	return -1;
    }

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
288
	print STDERR "ArchiveAdd: ".
289 290 291 292
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
293
	print STDERR "ArchiveAdd: $directory cannot be written!\n";
294 295
	return -1;
    }
296
    my $repodir   = "$directory/repo";
297 298
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = "$directory/checkins/$view";
299 300
    
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
301 302 303 304
    # 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). 
305
    #
306 307 308 309 310 311 312
    if (! -e "$checkin/$rootdir") {
	mysystem("$MKDIR $checkin/$rootdir") == 0 or return -1;
    }
    
    if (-f "/${rootdir}/${pathname}" || !$exact) {
	mysystem("$TAR cf - -C /$rootdir $pathname | ".
		 "$TAR xf - -C $checkin/$rootdir");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
313 314
    }
    else {
315 316
	mysystem("cd /$rootdir; ".
		 "$RSYNC -R -ax --delete ${pathname} $checkin/$rootdir");
317 318
    }
    if ($?) {
319
	print STDERR "ArchiveAdd: Could not copy in $realpath\n";
320 321 322 323 324 325
	return -1;
    }
    return 0;
}

#
326 327 328 329 330
# 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.
331
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
332
sub ArchiveSavePoint($;$$$)
333
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
334
    my ($archive_idx, $savetag, $view, $altdir) = @_;
335 336 337 338 339 340 341 342
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
343 344 345 346 347 348

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
349
	print STDERR "ArchiveSavePoint: ".
350
	    "Archive '$archive_idx' does not exist in the DB!\n";
351
	goto bad;
352 353
    }
    if (! -d $directory || ! -w $directory) {
354
	print STDERR "ArchiveSavePoint: $directory cannot be written!\n";
355
	goto bad;
356
    }
357
    my $repodir   = "$directory/repo";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
358
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
359 360 361 362 363 364

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

371
    # Get the current tag for the archive.
372 373
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
374 375 376 377 378 379 380 381 382 383 384 385 386 387
	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";
    }

388
    # Tags must start with a letter.
389 390 391 392
    if ($savetag =~ /^\d+/) {
	$savetag = "T" . $savetag;
    }
    
393
    #
394
    # Use svn import command. This is nice cause it handles all the
395 396 397
    # subdirs and stuff in one shot, instead of trying to deal with
    # each file and directory individually.
    #
398 399 400 401
    if (! chdir("$checkin")) {
	print STDERR "ArchiveSavePoint: Cannot chdir to $checkin!\n";
	goto bad;
    }
402
    mysystem("$IMPORTER -no_user_input file://$repodir ".
403
	     "          $view/savepoint . > /dev/null")
404 405 406 407 408
	== 0 or goto bad;

    #
    # Create the tag for this savepoint. 
    # 
409
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
410 411 412 413
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;
    
414 415 416 417

    #
    # And record the new tag. 
    # 
418
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
419
		"  tag='$savetag', view='$view', ".
420
		"  archive_idx='$archive_idx', ".
421
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
422

423
  okay:
424 425 426
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
427 428 429
    return 0;

  bad:
430 431 432
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
433 434 435 436 437 438 439
    return -1;
}

#
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
440
sub ArchiveCommit($;$$$)
441
{
442
    my ($archive_idx, $newtag, $view, $altdir) = @_;
443
    my $noactivity = 0;
444 445 446 447 448 449 450 451
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
452 453 454 455 456 457 458 459

    #
    # 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";
460
	goto bad;
461 462 463
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
464
	goto bad;
465
    }
466
    my $repodir   = "$directory/repo";
467 468
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
469 470 471 472 473 474 475 476

    # 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
477
	print STDERR "ArchiveCommit: Bad data in $cwd!\n";
478
	goto bad;
479 480
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
481 482
    if (! chdir("$directory")) {
	print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
483
	goto bad;
484 485 486
    }

    # Get the current tags for the archive.
487
    my ($archive_tag, $previous_tag);
488
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
489
			      \$previous_tag) < 0) {
490 491 492 493 494 495
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
496 497
    # Form new tag.
    # 
498 499 500
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
501 502

    if (!defined($newtag)) {
503
	$newtag = $import_tag . "_commit";
504 505
    }

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

511 512 513 514 515 516 517
    #
    # 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 ".
518
		    "where archive_idx='$archive_idx' and view='$view' ".
519 520 521 522 523 524 525 526 527 528
		    "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;
    }
    
529
    #
530 531 532
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
533 534 535 536 537 538 539 540 541
	#
	# Create a temporary spot to work in.
	# 
	if (! mkdir("merge.$$", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
	    goto bad;
	}
	chdir("merge.$$");
	
542
	#
543
	# Check out the current trunk.
544
	#
545 546 547
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

548
	#
549 550 551 552 553 554 555 556 557 558
	# 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;
559

560 561 562 563 564 565
	#
	# 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
566 567 568 569 570 571 572

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

575
    # Create a tag in the tags directory for the commit.
576
    mysystem("$SVN copy $svnopt -m 'ArchiveCommit' ".
577 578 579 580
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}")
	== 0 or goto bad;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
581 582 583
    # 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.
584
    mysystem("$SVN copy $svnopt -m 'ArchiveCommit' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
585 586 587 588
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/history/${newtag}")
	== 0 or goto bad;
    
589
    # Create a branch tag in the tags directory to base differences against.
590
    mysystem("$SVN copy $svnopt -m 'ArchiveCommit Branch' ".
591 592 593 594
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}-branch")
	== 0 or goto bad;
    
595
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
596
		"  tag='$newtag', view='$view', ".
597
		"  archive_idx='$archive_idx', ".
598 599
		"  date_created=UNIX_TIMESTAMP(now())")
	or goto bad;
600

601
    DBQueryWarn("update archive_views set ".
602
		"  current_tag='$newtag', ".
603
		"  previous_tag='$archive_tag' ".
604 605
		"where archive_idx='$archive_idx' and view='$view'")
	or goto bad;
606 607

    # Clean the temp dir for later.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
   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;
	}
623
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
624
   }
625

626 627 628
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
629
	goto bad;
630
    }
631
    mysystem("$SVN $svnopt update trunk");
632
    if ($?) {
633
	print STDERR "ArchiveCommit: Could not update head revision!\n";
634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653
	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.
#
654
sub ArchiveFork($$;$$$)
655
{
656 657
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
658 659 660 661 662 663 664 665 666 667 668 669 670 671
    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) {
672
	print STDERR "ArchiveCommit: ".
673 674 675 676 677
	    "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";
678
	goto bad;
679
    }
680
    my $repodir     = "$directory/repo";
681 682 683 684 685 686 687 688 689 690 691 692 693
    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
694
	print STDERR "ArchiveFork: Bad data in $cwd!\n";
695 696 697 698
	goto bad;
    }

    # Get the current tags for the archive.
699
    my ($archive_tag, $previous_tag);
700
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
701
			      \$previous_tag) < 0) {
702 703 704 705 706
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722
    #
    # 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;
    }

723 724 725 726 727 728 729 730 731
    # 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;
    }
732 733

    # Create newview directory in the repo.
734
    mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752
	     "          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.
753
    mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
754 755 756 757 758
	     "          file://$repodir/$newview/savepoint ".
	     "          file://$repodir/$newview/tags")
	== 0 or goto bad;

    # Now check it out. This creates the checkouts/$newview directory.
759
    mysystem("cd $checkouts; ".
760
	     "$SVN checkout $svnopt file://$repodir/$newview")
761 762
	== 0 or goto bad;

763 764 765 766 767
    # 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;
768
    
769 770 771
    # 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', ".
772
		"  view='$newview', ".
773
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
774

775
  okay:
776 777 778
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
779
    return 0;
780 781

  bad:
782 783 784
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
785
    return -1;
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 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 866 867 868 869
#
# 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;
}

870 871 872 873 874 875 876 877 878 879 880 881 882 883 884
#
# 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) {
885
	print STDERR "ArchiveArchive: ".
886 887 888
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904

    #
    # Need additional check to make sure that it has not already been
    # archived.
    #
    my ($archived, $date_archived);
    
    if (IsArchiveArchived($archive_idx, \$archived, \$date_archived) < 0) {
	return -1;
    }
    if ($archived) {
	print STDERR "ArchiveArchive: ".
	    "Archive '$archive_idx' already archived on $date_archived!\n";
	return 0;
    }
    
905
    if (! -d $directory || ! -w $directory) {
906
	print STDERR "ArchiveArchive: $directory cannot be written!\n";
907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924
	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.
    #
925
    mysystem("$TAR cf - -C $directory repo | tar xf - -C $target");
926 927 928 929
    if ($?) {
	print STDERR "ArchiveArchive: Could not copy in $directory\n";
	return -1;
    }
930 931 932 933

    #
    # Update its location in the DB, and remove the old directory.
    # 
934 935 936 937
    DBQueryWarn("update archives set ".
		"   directory='$target', ".
		"   archived=1, ".
		"   date_archived=UNIX_TIMESTAMP(now()) ".
938 939 940 941 942 943 944 945 946
		"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;
    }
947 948 949 950 951 952 953
    return 0;
}

#
# Destroy an archive. The DB state is retained unless optional flag says
# to clean it.
#
954
sub ArchiveDestroy($$)
955 956 957 958 959 960 961 962 963 964 965 966
{
    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;
    }
967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982

    #
    # Need additional check to make sure that it has not already been
    # archived. Do not want to do anything, unless clean is specified.
    #
    my ($archived, $date_archived);
    
    if (IsArchiveArchived($archive_idx, \$archived, \$date_archived) < 0) {
	return -1;
    }
    if ($archived && !$clean) {
	print STDERR "ArchiveDestroy: ".
	    "Archive '$archive_idx' archived on $date_archived!\n";
	return 0;
    }
    
983 984 985 986 987 988 989 990 991 992
    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;
    }
993
    if ($clean) {
994 995
	(DBQueryWarn("delete from archive_tags ".
		     "where archive_idx='$archive_idx'") &&
996 997
	 DBQueryWarn("delete from archive_views ".
		     "where archive_idx='$archive_idx'") &&
Leigh B. Stoller's avatar
Leigh B. Stoller committed
998
	 DBQueryWarn("delete from archives ".
999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012
		     "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
1013
	DBQueryWarn("select directory from archives where idx='$idx'");
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023

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

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

1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047
#
# See if the archive has already been archived away, and when.
#
sub IsArchiveArchived($$$)
{
    my ($idx, $parch, $pdate) = @_;
    
    my $query_result =
	DBQueryWarn("select archived,FROM_UNIXTIME(date_archived) ".
		    "  from archives where idx='$idx'");

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

    $$parch = $archived
	if (defined($parch));
    $$pdate = $date_archived
	if (defined($pdate));
    
    return 0;
}

1048 1049 1050 1051
#
# Get the current tag for an archive, given its index. Returns -1 on error,
# zero otherwise. Place tag in the return pointer.
#
1052
sub GetArchiveCurrentTags($$$;$)
1053
{
1054
    my ($archive_idx, $view, $tagp, $prevp) = @_;
1055 1056
    
    my $query_result =
1057
	DBQueryWarn("select v.current_tag,v.previous_tag ".
1058 1059 1060
		    "    from archive_views as v ".
		    "left join archive_tags as t on ".
		    "     t.archive_idx=v.archive_idx and ".
1061
		    "     t.tag=v.current_tag and t.view=v.view ".
1062 1063
		    "where v.archive_idx='$archive_idx' and ".
		    "      v.view='$view'");
1064 1065 1066

    return -1
	if (!$query_result);
1067
    my ($tag,$previous) = $query_result->fetchrow_array();
1068
    
1069 1070 1071 1072
    $$tagp = $tag
	if (defined($tagp));
    $$prevp = $previous
	if (defined($prevp));
1073 1074 1075 1076 1077 1078 1079 1080
    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.
#
1081
sub TBExperimentArchiveInfo($$$$)
1082
{
1083
    my ($pid, $eid, $idxp, $viewp) = @_;
1084 1085

    my $query_result =
1086
	DBQueryWarn("select s.archive_idx,e.idx from experiments as e ".
1087 1088 1089 1090 1091 1092
		    "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);

1093
    my ($archive_idx,$exptidx) = $query_result->fetchrow_array();
1094

1095 1096 1097
    # Need to deal with no archive yet!
    return 1
	if (!defined($archive_idx) || $archive_idx == 0);
1098 1099 1100 1101 1102

    $$idxp = $archive_idx
	if (defined($idxp));
    $$viewp = "$exptidx"
	if (defined($viewp));
1103
    
1104
    return 0;
1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117
}

#
# 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
1118 1119 1120
    return 0
	if (!$MAINSITE || $pid ne $ALLOWEDPID);

1121 1122 1123 1124 1125 1126 1127 1128 1129 1130
    # 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();
1131 1132
    my $archive_tag = "T${rsrcidx}";

1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144
    #
    # The point of this is to set the group of the new directory.
    #
    my $gid = ExpGroup($pid, $eid);
    if (! $gid) {
	return -1;
    }
    my ($unix_gid, $unix_name);
    if (!TBGroupUnixInfo($pid, $gid, \$unix_gid, \$unix_name)) {
	return -1;
    }

1145 1146 1147
    #
    # Create the new archive and get back the new index. 
    #
1148
    my $archive_idx = ArchiveCreate($archive_tag, "$exptidx", $unix_name);
1149 1150
    return -1
	if ($archive_idx < 0);