libArchive.pm.in 61.8 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2005, 2006, 2007 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
use Project;
23 24 25 26 27 28 29 30
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
31
my $MAINSITE    = @TBMAINSITE@;
32 33
my $ARCHSUPPORT = @ARCHIVESUPPORT@;
my $USEARCHIVE  = ($MAINSITE || $ARCHSUPPORT);
34
my %ALLOWEDPID  = ("testbed" => 1);
35 36 37 38 39 40 41 42
# 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";
43
my $SUCHOWN     = "$TB/sbin/suchown";
44
my $CHGRP       = "/usr/bin/chgrp";
45
my $TAR		= "/usr/bin/tar";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
46
my $RSYNC	= "/usr/local/bin/rsync";
47
my $RM		= "/bin/rm";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
48
my $REALPATH	= "/bin/realpath";
49 50 51
my $SVN         = "/usr/local/bin/svn";
my $SVNADMIN    = "/usr/local/bin/svnadmin";
my $IMPORTER    = "$TB/sbin/svn_load_dirs.pl";
52
my $DU          = "/usr/bin/du";
53
my $inittag     = 'root';
54
my $defaultview = 'head';
55
my $debug       = 0;
56
my $svnopt      = ($debug ? "" : "-q");
57 58 59 60 61 62 63 64 65
my $SHAREROOT   = SHAREROOT();
my $SCRATCHROOT = SCRATCHROOT();
my %ROOTS       = (PROJROOT()  => "proj",
		   USERROOT()  => "users",
		   $SHAREROOT  => "share",
		   GROUPROOT() => "groups");
if ($SCRATCHROOT) {
    $ROOTS{$SCRATCHROOT} = "scratch";
}
66

67 68 69 70 71
my $TAGTYPE_USER      = "user";
my $TAGTYPE_COMMIT    = "commit";
my $TAGTYPE_SAVEPOINT = "savepoint";
my $TAGTYPE_INTERNAL  = "internal";

72 73 74 75 76
#
# Set umask so that other people in the project can mess with the archive.
#
umask(0002);

77 78 79 80 81
# On or off
sub doarchiving($)
{
    my ($pid) = @_;
    
82 83 84 85
    my $project = Project->Lookup($pid);
    return 0
	if (!defined($project));
    
86
    return 1
87 88
	if ($USEARCHIVE &&
	    (exists($ALLOWEDPID{$pid}) || $project->allow_workbench()));
89 90 91 92
    
    return 0;
}

93 94 95 96 97
# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
98 99
    TBDebugTimeStampsOn();    

100 101 102 103
    # Need a big TMPDIR for svn stuff.
    my $tmpdir = $ENV{'TMPDIR'};
    $ENV{'TMPDIR'} = "/usr/testbed/tmp";

104 105
    print STDERR "Running '$command'\n"
	if ($debug);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106 107

    TBDebugTimeStamp($command);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108
    my $retval = system($command);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109
    TBDebugTimeStamp("Done");
110 111
    $ENV{'TMPDIR'} = $tmpdir
	if (defined($tmpdir));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
112 113

    return $retval;
114 115
}

116 117 118 119 120 121
# Another little helper for scripts that include this library.
sub setdebug($)
{
    my ($toggle) = @_;

    if ($toggle) {
122
	$debug  = $toggle;
123 124 125 126 127 128 129 130
	$svnopt = "";
    }
    else {
	$debug  = 0;
	$svnopt = "-q";
    }
}

131 132 133 134
#
# Create a new archive. Returns -1 if any error. Otherwise return
# the new record index.
# 
135
sub ArchiveCreate(;$$$)
136
{
137
    my ($tag, $view, $unix_gid) = @_;
138
    
139 140
    my $idx;
    my $dir;
141 142 143

    $tag = $inittag
	if (!defined($tag));
144 145
    $view = $defaultview
	if (!defined($view));
146

147
    # Tags cannot must start with a letter.
148 149 150
    if ($tag =~ /^\d+/) {
	$tag = "T" . $tag;
    }
151 152 153 154 155

    #
    # Need to create the directory for it, once we have the index.
    # 
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
156
	DBQueryWarn("insert into archives set ".
157
		    "  idx=NULL, ".
158 159 160 161 162 163 164 165 166 167 168 169 170 171
		    "  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;
172 173 174
    if (defined($unix_gid)) {
	mysystem("$CHGRP $unix_gid $dir") == 0 or goto bad;
    }
175

Leigh B. Stoller's avatar
Leigh B. Stoller committed
176
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
177 178 179
	or goto bad;

    #
180
    # Make subdirs. One to hold the control tree, and the other
181 182
    # to hold currently checked out versions of the tree. Lastly, we
    # need a place to copyin files before they are added to the repo.
183
    #
184
    my $repodir   = "$dir/repo";
185 186
    my $checkouts = "$dir/checkouts";
    my $checkins  = "$dir/checkins";
187

188 189
    if (! mkdir("$repodir", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $repodir: $!\n";
190 191
	goto bad;
    }
192 193
    if (! chmod(0777, "$repodir")) {
	print STDERR "ArchiveCreate: Could not chmod $repodir: $!\n";
194 195
	goto bad;
    }
196 197
    if (! mkdir("$checkouts", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkouts: $!\n";
198 199
	goto bad;
    }
200 201
    if (! chmod(0777, "$checkouts")) {
	print STDERR "ArchiveCreate: Could not chmod $checkouts: $!\n";
202 203
	goto bad;
    }
204 205
    if (! mkdir("$checkins", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins: $!\n";
206 207
	goto bad;
    }
208 209 210 211 212 213 214 215 216 217
    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";
218 219
	goto bad;
    }
220
    # Initialize the repo.
221
    mysystem("$SVNADMIN create --fs-type fsfs $repodir") == 0
222
	or goto bad;
223 224 225 226
    
    # 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
227
	     "         mkdir $view/history; ".
Timothy Stack's avatar
Timothy Stack committed
228
	     "$SVN import $svnopt -m 'ArchiveCreate' ".
229
	     "     $view file://$repodir/$view")
230 231 232
	== 0 or goto bad;

    # Create a branch tag in the tags directory to base differences against.
233
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
234 235
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${tag}-branch")
236
	== 0 or goto bad;
237 238 239 240 241 242 243 244

    # 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 $svnopt -m 'ArchiveCreate' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/history/${tag}")
	== 0 or goto bad;
245
    
246 247
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
248
	     "$SVN checkout $svnopt file://$repodir/$view")
249 250
	== 0 or goto bad;

251 252 253 254 255
    # 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;
    
256
    # Now enter an initial tag for the tree. Nothing actually gets tagged.
257 258
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
		"  tag='$tag', archive_idx='$idx', view='$view', ".
259
		"  tagtype='$TAGTYPE_INTERNAL', ".
260 261 262 263 264 265 266
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
    return $idx;

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
267 268 269
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
270
    DBQueryFatal("delete from archives where idx='$idx'")
271 272 273 274 275
	if (defined($idx));
    return -1;
}

#
276
# Helper function for below; Checks that a path is safe and legal.
277
#
278
sub ValidatePath($)
279
{
280 281 282
    my ($ppath)  = @_;
    # We get a pointer so we can return the new path.
    my $pathname = $$ppath;
283
    my $rootdir;
284

285 286 287 288 289
    # Taint check path before handing off to shell below.
    if ($pathname =~ /^([-\w\/\.\+\@,~]+)$/) {
	$pathname = $1;
    }
    else {
290 291
	print STDERR "*** ValidatePath: illegal characters in '$pathname'\n";
	return 1;
292 293
    }

294
    if (! -e $pathname || ! -r $pathname) {
295 296
	print STDERR "*** ValidatePath: $pathname cannot be read!\n";
	return 1;
297 298 299
    }

    #
300 301
    # Use realpath to check that the path does not contain links to
    # files outside the directory space the user is allowed to access.
302
    # We must taint check the result to keep everyone happy.
303
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
304
    my $realpath = `$REALPATH $pathname`;
305
    if ($realpath =~ /^([-\w\/\.\+\@,~]+)$/) {
306 307 308
	$realpath = $1;
    }
    else {
309
	print STDERR "*** ValidatePath: ".
310
	    "Bad data returned by realpath: $realpath\n";
311
	return -1;
312
    }
313

314
    #
315 316
    # Strip leading /dir from the pathname. We want a relative path to
    # the rootdir so we can copy it in.
317
    #
318
    if ($realpath =~ /^[\/]+(\w+)\/(.+)$/) {
319
	$rootdir  = "/$1";
320
	$pathname = $2;
321 322
    }
    else {
323 324
	print STDERR "*** ValidatePath: ".
	    "Illegal characters in pathname: $realpath\n";
325 326 327 328 329 330 331
	return -1;
    }

    #
    # The file must reside in one of the Emulab "root" filesystems.
    #
    if (! exists($ROOTS{$rootdir})) {
332
	print STDERR "*** ValidatePath: ".
333
	    "$realpath does not resolve to an allowed directory!\n";
334 335 336
	return -1;
    }

337 338 339 340 341 342 343 344 345 346
    $$ppath = $realpath;
    return 0;
}
    
#
# 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. 
#
347
sub ArchiveAdd($$;$$$)
348
{
349
    my ($archive_idx, $pathname, $view, $exact, $special) = @_;
350 351 352 353 354 355 356

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

    $exact = 0
	if (!defined($exact));

357 358 359
    $special = 0
	if (!defined($special));

360 361 362 363 364 365 366 367 368
    # This returns a taint checked value in $pathname.
    if (ValidatePath(\$pathname) != 0) {
	print STDERR "ArchiveAdd: Could not validate pathname $pathname\n";
	return -1;
    }

    #
    # Strip leading /dir from the pathname, we need it below.
    #
369 370 371 372 373
    my ($rootdir, $sourcedir, $sourcefile);
    my $rsyncopt = "";
    
    if ($special) {
	#
374 375
	# What does this do? 
	# Basically, we copy the last part (directory) to / of the checkin.
376
	# eg: cp /proj/pid/exp/eid... /exp of the checkins.
377 378 379
	# This avoids pid/eid tokens in the archive.
	#
	# Last part of path must be a directory.
380 381
	#
	if (! -d $pathname) {
382
	    print STDERR "ArchiveAdd: Must be a directory: $pathname\n";
383 384
	    return -1;
	}
385 386 387
	$rootdir    = "exp";
	$sourcedir  = $pathname;
	$sourcefile = "./";
388 389 390 391 392 393
    }
    elsif ($pathname =~ /^[\/]+(\w+)\/([-\w\/\.\+\@,~]+)$/) {
	$rootdir    = $1;
	$sourcedir  = $1;
	$sourcefile = $2;
	$rsyncopt   = "-R";
394 395 396 397 398 399
    }
    else {
	print STDERR "ArchiveAdd: Illegal characters in pathname $pathname\n";
	return -1;
    }

400 401 402 403 404
    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
405
	print STDERR "ArchiveAdd: ".
406 407 408 409
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
410
	print STDERR "ArchiveAdd: $directory cannot be written!\n";
411 412
	return -1;
    }
413
    my $repodir   = "$directory/repo";
414
    my $checkin   = "$directory/checkins/$view";
415 416 417 418 419 420 421 422 423

    #
    # If the target rootdir exists and is not writable by the current
    # user, then run a chown over the whole subdir. This will avoid
    # avoid permission problems later during the rsync/tar ops below.
    #
    if (-e "$checkin/$rootdir" && ! -o "$checkin/$rootdir") {
	mysystem("$SUCHOWN $checkin/$rootdir") == 0 or return -1
    }
424 425
    
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
426 427 428 429
    # 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). 
430
    #
431
    if (! -e "$checkin/$rootdir") {
432
	mysystem("$MKDIR $checkin/$rootdir") == 0 or return -1
433 434
    }
    
435 436
    if (-f "/${sourcedir}/${sourcefile}" || !$exact) {
	mysystem("$TAR cf - -C /$sourcedir $sourcefile | ".
437
		 "$TAR xf - -U -C $checkin/$rootdir");
438
	mysystem("$CHMOD 775 $checkin/$rootdir/$sourcefile");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
439 440
    }
    else {
441 442 443
	mysystem("cd /$sourcedir; ".
		 "$RSYNC $rsyncopt -rtgoDlz ".
		 "  --delete ${sourcefile} $checkin/$rootdir");
444 445
    }
    if ($?) {
446
	print STDERR "ArchiveAdd: Could not copy in $pathname\n";
447 448 449 450 451 452
	return -1;
    }
    return 0;
}

#
453 454 455 456 457
# 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.
458
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
459
sub ArchiveSavePoint($;$$$)
460
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
461
    my ($archive_idx, $savetag, $view, $altdir) = @_;
462 463 464 465 466 467
    my $cwd;

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

    return -1
468
	if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
469
	    TBSCRIPTLOCK_OKAY());
470 471 472 473 474 475

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
476
	print STDERR "ArchiveSavePoint: ".
477
	    "Archive '$archive_idx' does not exist in the DB!\n";
478
	goto bad;
479 480
    }
    if (! -d $directory || ! -w $directory) {
481
	print STDERR "ArchiveSavePoint: $directory cannot be written!\n";
482
	goto bad;
483
    }
484
    my $repodir   = "$directory/repo";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
485
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
486 487 488 489 490 491

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

498
    # Get the current tag for the archive.
499 500
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
501 502 503 504 505 506 507 508 509 510 511 512 513 514
	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";
    }

515
    # Tags must start with a letter.
516 517 518 519
    if ($savetag =~ /^\d+/) {
	$savetag = "T" . $savetag;
    }
    
520
    #
521
    # Use svn import command. This is nice cause it handles all the
522 523 524
    # subdirs and stuff in one shot, instead of trying to deal with
    # each file and directory individually.
    #
525 526 527 528
    if (! chdir("$checkin")) {
	print STDERR "ArchiveSavePoint: Cannot chdir to $checkin!\n";
	goto bad;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
529 530 531
    # Avoid a core file from svn.
    mysystem("ulimit -c 0; $IMPORTER -no_user_input file://$repodir ".
	     "                 $view/savepoint . " .
532
	     ($debug < 2 ? "> /dev/null 2>&1" : ""))
533 534 535 536 537
	== 0 or goto bad;

    #
    # Create the tag for this savepoint. 
    # 
538
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
539 540 541 542
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;
    
543 544 545 546

    #
    # And record the new tag. 
    # 
547
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
548
		"  tag='$savetag', view='$view', ".
549
		"  archive_idx='$archive_idx', ".
550
		"  tagtype='$TAGTYPE_SAVEPOINT', ".
551
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
552

553
  okay:
554 555 556
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
557 558 559
    return 0;

  bad:
560 561 562
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
563 564 565
    return -1;
}

566 567 568 569 570 571 572 573 574 575 576 577 578 579
#
# Add an informational tag to an archive, in the tags directory. This just
# does a copy of the current trunk, and is intended to allow users to add
# their own named tags as they like.
#
sub ArchiveTag($;$$$)
{
    my ($archive_idx, $savetag, $subdir, $view) = @_;
    my $cwd;

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

    return -1
580
	if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667
	    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 "ArchiveTag: ".
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveTag: $directory cannot be written!\n";
	goto bad;
    }
    my $repodir   = "$directory/repo";

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

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

    #
    # Check to see if the subdir needs to be created. I cannot find a
    # better way then the svn list command ...
    #
    if (defined($subdir)) {
	my @tokens = split("/", $subdir);
	my $path   = "";

	while (@tokens) {
	    my $token = shift(@tokens);

	    $path = "$path/$token";

	    mysystem("$SVN list file://$repodir/$view/tags${path} ".
		     "  > /dev/null");
	    if ($?) {
		mysystem("$SVN mkdir $svnopt -m 'ArchiveTag mkdir' ".
			 "          file://$repodir/$view/tags${path}")
		    == 0 or goto bad;
	    }
	}

	# Prepend subdir to tag
	$savetag = "$subdir/$savetag";
    }

    # Check to make sure the complete path does not already exist
    mysystem("$SVN list file://$repodir/$view/tags/${savetag} > /dev/null");
    if (! $?) {
	print STDERR "ArchiveTag: tag already exists!\n";
	goto bad;
    }
    
    #
    # Create the tag ...
    # 
    mysystem("$SVN copy $svnopt -m 'ArchiveTag' ".
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;

  okay:
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
    return 0;

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

668 669 670 671
#
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
672
sub ArchiveCommit($;$$$$)
673
{
674
    my ($archive_idx, $newtag, $mfile, $view, $altdir) = @_;
675
    my $noactivity = 0;
676 677 678 679 680 681
    my $cwd;

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

    return -1
682
	if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
683
	    TBSCRIPTLOCK_OKAY());
684 685 686 687 688 689 690 691

    #
    # 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";
692
	goto bad;
693 694 695
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
696
	goto bad;
697
    }
698
    my $repodir   = "$directory/repo";
699 700
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
701 702 703 704 705 706 707 708

    # 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
709
	print STDERR "ArchiveCommit: Bad data in $cwd!\n";
710
	goto bad;
711 712
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
713 714
    if (! chdir("$directory")) {
	print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
715
	goto bad;
716 717 718
    }

    # Get the current tags for the archive.
719
    my ($archive_tag, $previous_tag);
720
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
721
			      \$previous_tag) < 0) {
722 723 724 725 726 727
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
728 729
    # Form new tag.
    # 
730 731 732
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
733 734

    if (!defined($newtag)) {
735
	$newtag = $import_tag . "_commit";
736 737
    }

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

743 744 745 746 747 748 749
    #
    # 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 ".
750
		    "where archive_idx='$archive_idx' and view='$view' ".
751 752 753 754 755 756 757 758 759
		    "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;
    }
760 761 762 763 764 765 766 767 768 769 770 771 772

    #
    # Message can come from a file. 
    #
    my $message_arg = "-m 'Commit merge of ${archive_tag} to trunk'";

    if (defined($mfile)) {
	if (! -r $mfile) {
	    print STDERR "*** ArchiveCommit: $mfile cannot be read!\n";
	    goto bad;
	}
	$message_arg = "-F $mfile";
    }
773
    
774
    #
775 776 777
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
778 779 780 781 782 783 784 785 786
	#
	# Create a temporary spot to work in.
	# 
	if (! mkdir("merge.$$", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
	    goto bad;
	}
	chdir("merge.$$");
	
787
	#
788
	# Check out the current trunk.
789
	#
790 791 792
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

793
	#
794 795 796 797 798 799 800 801 802 803
	# 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;
804

805
	mysystem("$SVN commit $svnopt $message_arg trunk")
806
	    == 0 or goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
807 808 809 810 811 812 813

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

816
    # Create a tag in the tags directory for the commit.
817
    mysystem("$SVN copy $svnopt $message_arg ".
818 819 820 821
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}")
	== 0 or goto bad;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
822 823 824
    # 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.
825
    mysystem("$SVN copy $svnopt $message_arg ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
826 827 828 829
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/history/${newtag}")
	== 0 or goto bad;
    
830
    # Create a branch tag in the tags directory to base differences against.
831
    mysystem("$SVN copy $svnopt -m 'ArchiveCommit Branch' ".
832 833 834
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}-branch")
	== 0 or goto bad;
835 836 837 838

    # For putting message into DB.
    my $dclause = (defined($mfile) ? 
		   ", description=" . DBQuoteSpecial(`cat $mfile`) : "");
839
    
840
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
841
		"  tag='$newtag', view='$view', ".
842
		"  archive_idx='$archive_idx', ".
843 844
		"  tagtype='$TAGTYPE_COMMIT', ".
		"  date_created=UNIX_TIMESTAMP(now()) $dclause")
845
	or goto bad;
846

847
    DBQueryWarn("update archive_views set ".
848
		"  current_tag='$newtag', ".
849
		"  previous_tag='$archive_tag' ".
850 851
		"where archive_idx='$archive_idx' and view='$view'")
	or goto bad;
852

853 854 855
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
856
	goto bad;
857
    }
858
    mysystem("$SVN $svnopt update trunk");
859
    if ($?) {
860
	print STDERR "ArchiveCommit: Could not update head revision!\n";
861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880
	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.
#
881
sub ArchiveFork($$;$$$)
882
{
883 884
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
885 886 887 888 889 890
    my $cwd;

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

    return -1
891
	if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
892 893 894 895 896 897 898
	    TBSCRIPTLOCK_OKAY());

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
899
	print STDERR "ArchiveFork: ".
900 901 902 903
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
904
	print STDERR "ArchiveFork: $directory cannot be written!\n";
905
	goto bad;
906
    }
907
    my $repodir     = "$directory/repo";
908 909 910 911 912 913 914 915 916 917 918 919 920
    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
921
	print STDERR "ArchiveFork: Bad data in $cwd!\n";
922 923 924 925
	goto bad;
    }

    # Get the current tags for the archive.
926
    my ($archive_tag, $previous_tag);
927
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
928
			      \$previous_tag) < 0) {
929
	print STDERR "ArchiveFork: ".
930 931 932 933
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949
    #
    # 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;
    }

950 951
    # Create new view directories and checkout.
    if (! mkdir("$newcheckin", 0777)) {
952
	print STDERR "ArchiveFork: Could not mkdir $newcheckin: $!\n";
953 954 955
	goto bad;
    }
    if (! chmod(0777, "$newcheckin")) {
956
	print STDERR "ArchiveFork: Could not chmod $newcheckin: $!\n";
957 958
	goto bad;
    }
959 960

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

965 966 967 968 969 970 971 972 973 974 975 976
    #
    # If no branchtag supplied, we want to branch at the trunk. But we still
    # need to mark it with a tag or else we have no idea later what actually
    # happened.
    #
    if (!defined($branchtag)) {
	$branchtag = $import_tag . "_fork";

	mysystem("$SVN copy $svnopt -m 'ArchiveFork' ".
		 "          file://$repodir/$view/trunk ".
		 "          file://$repodir/$view/tags/$branchtag")
	    == 0 or goto bad;
977
    }
978
    $sourcepoint = "tags/$branchtag";
979 980 981 982 983 984 985

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

986 987 988 989 990 991 992
    # Ditto for the savepoints directory. 
    mysystem("$SVN copy $svnopt -m 'ArchiveFork' ".
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$newview/savepoint")
	== 0 or goto bad;

    # Do not want to copy the tags/history directories. Add new ones.
993
    mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
994
	     "          file://$repodir/$newview/history ".
995 996 997
	     "          file://$repodir/$newview/tags")
	== 0 or goto bad;

998 999 1000 1001 1002
    # Create a branch tag in the tags directory to base differences against.
    mysystem("$SVN copy $svnopt -m 'ArchiveFork Branch' ".
	     "          file://$repodir/$newview/trunk ".
	     "          file://$repodir/$newview/tags/${newtag}-branch")
	== 0 or goto bad;
1003 1004 1005 1006 1007 1008 1009 1010

    # 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 $svnopt -m 'ArchiveFork Branch' ".
	     "          file://$repodir/$newview/trunk ".
	     "          file://$repodir/$newview/history/${newtag}")
	== 0 or goto bad;
1011
    
1012
    # Now check it out. This creates the checkouts/$newview directory.
1013
    mysystem("cd $checkouts; ".
1014
	     "$SVN checkout $svnopt file://$repodir/$newview")
1015 1016
	== 0 or goto bad;

1017 1018 1019 1020
    # Now enter the newview (okay, branch) of this archive.
    DBQueryWarn("insert into archive_views set ".
		"  current_tag='$newtag', archive_idx='$archive_idx', ".
		"  view='$newview', ".
1021
		"  parent_view='$view', branch_tag='$branchtag', ".
1022
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
1023
    
1024 1025 1026
    # 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', ".
1027
		"  tagtype='$TAGTYPE_INTERNAL', ".
1028
		"  view='$newview', ".
1029
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
1030

1031
  okay:
1032 1033 1034
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
1035
    return 0;