libArchive.pm.in 59.6 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 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
my $MAINSITE    = @TBMAINSITE@;
31 32
my $ARCHSUPPORT = @ARCHIVESUPPORT@;
my $USEARCHIVE  = ($MAINSITE || $ARCHSUPPORT);
33 34
my %ALLOWEDPID  = ("testbed" => 1, "compadres" => 1, "tbres" => 1,
		   "fightfire" => 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 $inittag     = 'root';
53
my $defaultview = 'head';
54
my $debug       = 0;
55
my $svnopt      = ($debug ? "" : "-q");
56 57 58 59 60 61 62 63 64
my $SHAREROOT   = SHAREROOT();
my $SCRATCHROOT = SCRATCHROOT();
my %ROOTS       = (PROJROOT()  => "proj",
		   USERROOT()  => "users",
		   $SHAREROOT  => "share",
		   GROUPROOT() => "groups");
if ($SCRATCHROOT) {
    $ROOTS{$SCRATCHROOT} = "scratch";
}
65

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

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

76 77 78 79 80 81 82 83 84 85 86
# On or off
sub doarchiving($)
{
    my ($pid) = @_;
    
    return 1
	if ($USEARCHIVE && exists($ALLOWEDPID{$pid}));
    
    return 0;
}

87 88 89 90 91
# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
92 93
    TBDebugTimeStampsOn();    

94 95 96 97
    # Need a big TMPDIR for svn stuff.
    my $tmpdir = $ENV{'TMPDIR'};
    $ENV{'TMPDIR'} = "/usr/testbed/tmp";

98 99
    print STDERR "Running '$command'\n"
	if ($debug);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100 101

    TBDebugTimeStamp($command);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
102
    my $retval = system($command);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
103
    TBDebugTimeStamp("Done");
104 105
    $ENV{'TMPDIR'} = $tmpdir
	if (defined($tmpdir));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106 107

    return $retval;
108 109
}

110 111 112 113 114 115
# Another little helper for scripts that include this library.
sub setdebug($)
{
    my ($toggle) = @_;

    if ($toggle) {
116
	$debug  = $toggle;
117 118 119 120 121 122 123 124
	$svnopt = "";
    }
    else {
	$debug  = 0;
	$svnopt = "-q";
    }
}

125 126 127 128
#
# Create a new archive. Returns -1 if any error. Otherwise return
# the new record index.
# 
129
sub ArchiveCreate(;$$$)
130
{
131
    my ($tag, $view, $unix_gid) = @_;
132
    
133 134
    my $idx;
    my $dir;
135 136 137

    $tag = $inittag
	if (!defined($tag));
138 139
    $view = $defaultview
	if (!defined($view));
140

141
    # Tags cannot must start with a letter.
142 143 144
    if ($tag =~ /^\d+/) {
	$tag = "T" . $tag;
    }
145 146 147 148 149

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
170
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
171 172 173
	or goto bad;

    #
174
    # Make subdirs. One to hold the control tree, and the other
175 176
    # to hold currently checked out versions of the tree. Lastly, we
    # need a place to copyin files before they are added to the repo.
177
    #
178
    my $repodir   = "$dir/repo";
179 180
    my $checkouts = "$dir/checkouts";
    my $checkins  = "$dir/checkins";
181

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

    # Create a branch tag in the tags directory to base differences against.
227
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
228 229
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${tag}-branch")
230
	== 0 or goto bad;
231 232 233 234 235 236 237 238

    # 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;
239
    
240 241
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
242
	     "$SVN checkout $svnopt file://$repodir/$view")
243 244
	== 0 or goto bad;

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

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
261 262 263
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264
    DBQueryFatal("delete from archives where idx='$idx'")
265 266 267 268 269
	if (defined($idx));
    return -1;
}

#
270
# Helper function for below; Checks that a path is safe and legal.
271
#
272
sub ValidatePath($)
273
{
274 275 276
    my ($ppath)  = @_;
    # We get a pointer so we can return the new path.
    my $pathname = $$ppath;
277
    my $rootdir;
278

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

288
    if (! -e $pathname || ! -r $pathname) {
289 290
	print STDERR "*** ValidatePath: $pathname cannot be read!\n";
	return 1;
291 292 293
    }

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

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

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

331 332 333 334 335 336 337 338 339 340
    $$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. 
#
341
sub ArchiveAdd($$;$$$)
342
{
343
    my ($archive_idx, $pathname, $view, $exact, $special) = @_;
344 345 346 347 348 349 350

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

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

351 352 353
    $special = 0
	if (!defined($special));

354 355 356 357 358 359 360 361 362
    # 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.
    #
363 364 365 366 367
    my ($rootdir, $sourcedir, $sourcefile);
    my $rsyncopt = "";
    
    if ($special) {
	#
368 369
	# What does this do? 
	# Basically, we copy the last part (directory) to / of the checkin.
370
	# eg: cp /proj/pid/exp/eid... /exp of the checkins.
371 372 373
	# This avoids pid/eid tokens in the archive.
	#
	# Last part of path must be a directory.
374 375
	#
	if (! -d $pathname) {
376
	    print STDERR "ArchiveAdd: Must be a directory: $pathname\n";
377 378
	    return -1;
	}
379 380 381
	$rootdir    = "exp";
	$sourcedir  = $pathname;
	$sourcefile = "./";
382 383 384 385 386 387
    }
    elsif ($pathname =~ /^[\/]+(\w+)\/([-\w\/\.\+\@,~]+)$/) {
	$rootdir    = $1;
	$sourcedir  = $1;
	$sourcefile = $2;
	$rsyncopt   = "-R";
388 389 390 391 392 393
    }
    else {
	print STDERR "ArchiveAdd: Illegal characters in pathname $pathname\n";
	return -1;
    }

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

    #
    # 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
    }
418 419
    
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
420 421 422 423
    # 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). 
424
    #
425
    if (! -e "$checkin/$rootdir") {
426
	mysystem("$MKDIR $checkin/$rootdir") == 0 or return -1
427 428
    }
    
429 430
    if (-f "/${sourcedir}/${sourcefile}" || !$exact) {
	mysystem("$TAR cf - -C /$sourcedir $sourcefile | ".
431
		 "$TAR xf - -U -C $checkin/$rootdir");
432
	mysystem("$CHMOD 775 $checkin/$rootdir/$sourcefile");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
433 434
    }
    else {
435 436 437
	mysystem("cd /$sourcedir; ".
		 "$RSYNC $rsyncopt -rtgoDlz ".
		 "  --delete ${sourcefile} $checkin/$rootdir");
438 439
    }
    if ($?) {
440
	print STDERR "ArchiveAdd: Could not copy in $pathname\n";
441 442 443 444 445 446
	return -1;
    }
    return 0;
}

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

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
464 465 466 467 468 469

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

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

492
    # Get the current tag for the archive.
493 494
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
495 496 497 498 499 500 501 502 503 504 505 506 507 508
	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";
    }

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

    #
    # Create the tag for this savepoint. 
    # 
532
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
533 534 535 536
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;
    
537 538 539 540

    #
    # And record the new tag. 
    # 
541
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
542
		"  tag='$savetag', view='$view', ".
543
		"  archive_idx='$archive_idx', ".
544
		"  tagtype='$TAGTYPE_SAVEPOINT', ".
545
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
546

547
  okay:
548 549 550
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
551 552 553
    return 0;

  bad:
554 555 556
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
557 558 559
    return -1;
}

560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 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
#
# 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
	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 "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;
}

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

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
678 679 680 681 682 683 684 685

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

    # 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
703
	print STDERR "ArchiveCommit: Bad data in $cwd!\n";
704
	goto bad;
705 706
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
707 708
    if (! chdir("$directory")) {
	print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
709
	goto bad;
710 711 712
    }

    # Get the current tags for the archive.
713
    my ($archive_tag, $previous_tag);
714
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
715
			      \$previous_tag) < 0) {
716 717 718 719 720 721
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
722 723
    # Form new tag.
    # 
724 725 726
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
727 728

    if (!defined($newtag)) {
729
	$newtag = $import_tag . "_commit";
730 731
    }

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

737 738 739 740 741 742 743
    #
    # 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 ".
744
		    "where archive_idx='$archive_idx' and view='$view' ".
745 746 747 748 749 750 751 752 753
		    "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;
    }
754 755 756 757 758 759 760 761 762 763 764 765 766

    #
    # 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";
    }
767
    
768
    #
769 770 771
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
772 773 774 775 776 777 778 779 780
	#
	# Create a temporary spot to work in.
	# 
	if (! mkdir("merge.$$", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
	    goto bad;
	}
	chdir("merge.$$");
	
781
	#
782
	# Check out the current trunk.
783
	#
784 785 786
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

787
	#
788 789 790 791 792 793 794 795 796 797
	# 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;
798

799
	mysystem("$SVN commit $svnopt $message_arg trunk")
800
	    == 0 or goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
801 802 803 804 805 806 807

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

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

    # For putting message into DB.
    my $dclause = (defined($mfile) ? 
		   ", description=" . DBQuoteSpecial(`cat $mfile`) : "");
833
    
834
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
835
		"  tag='$newtag', view='$view', ".
836
		"  archive_idx='$archive_idx', ".
837 838
		"  tagtype='$TAGTYPE_COMMIT', ".
		"  date_created=UNIX_TIMESTAMP(now()) $dclause")
839
	or goto bad;
840

841
    DBQueryWarn("update archive_views set ".
842
		"  current_tag='$newtag', ".
843
		"  previous_tag='$archive_tag' ".
844 845
		"where archive_idx='$archive_idx' and view='$view'")
	or goto bad;
846

847 848 849
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
850
	goto bad;
851
    }
852
    mysystem("$SVN $svnopt update trunk");
853
    if ($?) {
854
	print STDERR "ArchiveCommit: Could not update head revision!\n";
855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874
	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.
#
875
sub ArchiveFork($$;$$$)
876
{
877 878
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
879 880 881 882 883 884 885 886 887 888 889 890 891 892
    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) {
893
	print STDERR "ArchiveFork: ".
894 895 896 897
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
898
	print STDERR "ArchiveFork: $directory cannot be written!\n";
899
	goto bad;
900
    }
901
    my $repodir     = "$directory/repo";
902 903 904 905 906 907 908 909 910 911 912 913 914
    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
915
	print STDERR "ArchiveFork: Bad data in $cwd!\n";
916 917 918 919
	goto bad;
    }

    # Get the current tags for the archive.
920
    my ($archive_tag, $previous_tag);
921
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
922
			      \$previous_tag) < 0) {
923
	print STDERR "ArchiveFork: ".
924 925 926 927
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943
    #
    # 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;
    }

944 945
    # Create new view directories and checkout.
    if (! mkdir("$newcheckin", 0777)) {
946
	print STDERR "ArchiveFork: Could not mkdir $newcheckin: $!\n";
947 948 949
	goto bad;
    }
    if (! chmod(0777, "$newcheckin")) {
950
	print STDERR "ArchiveFork: Could not chmod $newcheckin: $!\n";
951 952
	goto bad;
    }
953 954

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

959 960 961 962 963 964 965 966 967 968 969 970
    #
    # 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;
971
    }
972
    $sourcepoint = "tags/$branchtag";
973 974 975 976 977 978 979

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

980 981 982 983 984 985 986
    # 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.
987
    mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
988
	     "          file://$repodir/$newview/history ".
989 990 991
	     "          file://$repodir/$newview/tags")
	== 0 or goto bad;

992 993 994 995 996
    # 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;
997 998 999 1000 1001 1002 1003 1004

    # 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;
1005
    
1006
    # Now check it out. This creates the checkouts/$newview directory.
1007
    mysystem("cd $checkouts; ".
1008
	     "$SVN checkout $svnopt file://$repodir/$newview")
1009 1010
	== 0 or goto bad;

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

1025
  okay:
1026 1027 1028
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
1029
    return 0;
1030 1031

  bad:
1032 1033 1034
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
1035
    return -1;
1036 1037
}

1038 1039 1040
#
# Checkout a copy of the archive, optionally at a particular view/branch.
#
1041
sub ArchiveCheckout($$;$$$)
1042
{
1043
    my ($archive_idx, $target, $view, $tag, $subdir) = @_;
1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067