libArchive.pm.in 54.7 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
my $MAINSITE    = @TBMAINSITE@;
31
32
my $ARCHSUPPORT = @ARCHIVESUPPORT@;
my $USEARCHIVE  = ($MAINSITE || $ARCHSUPPORT);
33
my %ALLOWEDPID  = ("testbed" => 1, "compadres" => 1, "tbres" => 1);
34
35
36
37
38
39
40
41
# XXX
my $ARCHIVEDIR  = "/usr/testbed/exparchive";
my $TESTMODE    = @TESTMODE@;
my $TBOPS       = "@TBOPSEMAIL@";
my $ELABINELAB  = @ELABINELAB@;
my $MD5		= "/sbin/md5";
my $MKDIR       = "/bin/mkdir";
my $CHMOD       = "/bin/chmod";
42
my $CHGRP       = "/usr/bin/chgrp";
43
my $TAR		= "/usr/bin/tar";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
my $RSYNC	= "/usr/local/bin/rsync";
45
my $RM		= "/bin/rm";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
46
my $REALPATH	= "/bin/realpath";
47
48
49
my $SVN         = "/usr/local/bin/svn";
my $SVNADMIN    = "/usr/local/bin/svnadmin";
my $IMPORTER    = "$TB/sbin/svn_load_dirs.pl";
50
my $inittag     = 'root';
51
my $defaultview = 'head';
52
my $debug       = 0;
53
my $svnopt      = ($debug ? "" : "-q");
54
55
56
57
my %ROOTS       = ("proj"   => "proj",
		   "users"  => "users",
		   "share"  => "share",
		   "groups" => "groups");
58

59
60
61
62
63
my $TAGTYPE_USER      = "user";
my $TAGTYPE_COMMIT    = "commit";
my $TAGTYPE_SAVEPOINT = "savepoint";
my $TAGTYPE_INTERNAL  = "internal";

64
65
66
67
68
#
# Set umask so that other people in the project can mess with the archive.
#
umask(0002);

69
70
71
72
73
74
75
76
77
78
79
80

# On or off
sub doarchiving($)
{
    my ($pid) = @_;
    
    return 1
	if ($USEARCHIVE && exists($ALLOWEDPID{$pid}));
    
    return 0;
}

81
82
83
84
85
86
87
88
89
90
# Little helper and debug function.
sub mysystem($)
{
    my ($command) = @_;

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

91
92
93
94
95
96
# Another little helper for scripts that include this library.
sub setdebug($)
{
    my ($toggle) = @_;

    if ($toggle) {
97
	$debug  = $toggle;
98
99
100
101
102
103
104
105
	$svnopt = "";
    }
    else {
	$debug  = 0;
	$svnopt = "-q";
    }
}

106
107
108
109
#
# Create a new archive. Returns -1 if any error. Otherwise return
# the new record index.
# 
110
sub ArchiveCreate(;$$$)
111
{
112
    my ($tag, $view, $unix_gid) = @_;
113
    
114
115
    my $idx;
    my $dir;
116
117
118

    $tag = $inittag
	if (!defined($tag));
119
120
    $view = $defaultview
	if (!defined($view));
121

122
    # Tags cannot must start with a letter.
123
124
125
    if ($tag =~ /^\d+/) {
	$tag = "T" . $tag;
    }
126
127
128
129
130

    #
    # Need to create the directory for it, once we have the index.
    # 
    my $query_result =
Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
	DBQueryWarn("insert into archives set ".
132
		    "  idx=NULL, ".
133
134
135
136
137
138
139
140
141
142
143
144
145
146
		    "  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;
147
148
149
    if (defined($unix_gid)) {
	mysystem("$CHGRP $unix_gid $dir") == 0 or goto bad;
    }
150

Leigh B. Stoller's avatar
Leigh B. Stoller committed
151
    DBQueryWarn("update archives set directory='$dir' where idx='$idx'")
152
153
154
	or goto bad;

    #
155
    # Make subdirs. One to hold the control tree, and the other
156
157
    # to hold currently checked out versions of the tree. Lastly, we
    # need a place to copyin files before they are added to the repo.
158
    #
159
    my $repodir   = "$dir/repo";
160
161
    my $checkouts = "$dir/checkouts";
    my $checkins  = "$dir/checkins";
162

163
164
    if (! mkdir("$repodir", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $repodir: $!\n";
165
166
	goto bad;
    }
167
168
    if (! chmod(0777, "$repodir")) {
	print STDERR "ArchiveCreate: Could not chmod $repodir: $!\n";
169
170
	goto bad;
    }
171
172
    if (! mkdir("$checkouts", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkouts: $!\n";
173
174
	goto bad;
    }
175
176
    if (! chmod(0777, "$checkouts")) {
	print STDERR "ArchiveCreate: Could not chmod $checkouts: $!\n";
177
178
	goto bad;
    }
179
180
    if (! mkdir("$checkins", 0777)) {
	print STDERR "ArchiveCreate: Could not mkdir $checkins: $!\n";
181
182
	goto bad;
    }
183
184
185
186
187
188
189
190
191
192
    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";
193
194
	goto bad;
    }
195
196
    # Initialize the repo.
    mysystem("$SVNADMIN create $repodir") == 0
197
	or goto bad;
198
199
200
201
    
    # 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
202
	     "         mkdir $view/history; ".
Timothy Stack's avatar
Timothy Stack committed
203
	     "$SVN import $svnopt -m 'ArchiveCreate' ".
204
	     "     $view file://$repodir/$view")
205
206
207
	== 0 or goto bad;

    # Create a branch tag in the tags directory to base differences against.
208
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
209
210
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${tag}-branch")
211
	== 0 or goto bad;
212
213
214
215
216
217
218
219

    # 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;
220
    
221
222
    # Now check it out. This creates the $checkouts/$view directory.
    mysystem("cd $checkouts; ".
223
	     "$SVN checkout $svnopt file://$repodir/$view")
224
225
	== 0 or goto bad;

226
227
228
229
230
    # 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;
    
231
    # Now enter an initial tag for the tree. Nothing actually gets tagged.
232
233
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
		"  tag='$tag', archive_idx='$idx', view='$view', ".
234
		"  tagtype='$TAGTYPE_INTERNAL', ".
235
236
237
238
239
240
241
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
    
    return $idx;

  bad:
#    mysystem("$RM -rf $dir")
#        if (defined($dir));
242
243
244
    DBQueryFatal("delete from archive_views ".
		 "where view='$view' and archive_idx='$idx'")
	if (defined($idx));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245
    DBQueryFatal("delete from archives where idx='$idx'")
246
247
248
249
250
	if (defined($idx));
    return -1;
}

#
251
# Helper function for below; Checks that a path is safe and legal.
252
#
253
sub ValidatePath($)
254
{
255
256
257
    my ($ppath)  = @_;
    # We get a pointer so we can return the new path.
    my $pathname = $$ppath;
258
    my $rootdir;
259

260
261
262
263
264
    # Taint check path before handing off to shell below.
    if ($pathname =~ /^([-\w\/\.\+\@,~]+)$/) {
	$pathname = $1;
    }
    else {
265
266
	print STDERR "*** ValidatePath: illegal characters in '$pathname'\n";
	return 1;
267
268
    }

269
    if (! -e $pathname || ! -r $pathname) {
270
271
	print STDERR "*** ValidatePath: $pathname cannot be read!\n";
	return 1;
272
273
274
    }

    #
275
276
    # Use realpath to check that the path does not contain links to
    # files outside the directory space the user is allowed to access.
277
    # We must taint check the result to keep everyone happy.
278
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
279
    my $realpath = `$REALPATH $pathname`;
280
    if ($realpath =~ /^([-\w\/\.\+\@,~]+)$/) {
281
282
283
	$realpath = $1;
    }
    else {
284
	print STDERR "*** ValidatePath: ".
285
	    "Bad data returned by realpath: $realpath\n";
286
	return -1;
287
    }
288

289
    #
290
291
    # Strip leading /dir from the pathname. We want a relative path to
    # the rootdir so we can copy it in.
292
    #
293
    if ($realpath =~ /^[\/]+(\w+)\/(.+)$/) {
294
295
	$rootdir  = $1;
	$pathname = $2;
296
297
    }
    else {
298
299
	print STDERR "*** ValidatePath: ".
	    "Illegal characters in pathname: $realpath\n";
300
301
302
303
304
305
306
	return -1;
    }

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

312
313
314
315
316
317
318
319
320
321
    $$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. 
#
322
sub ArchiveAdd($$;$$$)
323
{
324
    my ($archive_idx, $pathname, $view, $exact, $special) = @_;
325
326
327
328
329
330
331

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

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

332
333
334
    $special = 0
	if (!defined($special));

335
336
337
338
339
340
341
342
343
    # 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.
    #
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    my ($rootdir, $sourcedir, $sourcefile);
    my $rsyncopt = "";
    
    if ($special) {
	#
	# Last parth of path must be a directory.
	#
	if (! -d $pathname) {
	    print STDERR "ArchiveAdd: Must be a direcotory: $pathname\n";
	    return -1;
	}
	my ($filename,$directory,undef) = fileparse($pathname);

	#
	# Basically, copy the last part (directory) to / of the checkin.
	# eg: cp /proj/pid/exp/eid/archive/... /archive of the checkins.
	#
	$rootdir    = $filename;
	$sourcedir  = $directory;
	$sourcefile = $filename . "/";
    }
    elsif ($pathname =~ /^[\/]+(\w+)\/([-\w\/\.\+\@,~]+)$/) {
	$rootdir    = $1;
	$sourcedir  = $1;
	$sourcefile = $2;
	$rsyncopt   = "-R";
370
371
372
373
374
375
    }
    else {
	print STDERR "ArchiveAdd: Illegal characters in pathname $pathname\n";
	return -1;
    }

376
377
378
379
380
    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
381
	print STDERR "ArchiveAdd: ".
382
383
384
385
	    "Archive '$archive_idx' does not exist in the DB!\n";
	return -1;
    }
    if (! -d $directory || ! -w $directory) {
386
	print STDERR "ArchiveAdd: $directory cannot be written!\n";
387
388
	return -1;
    }
389
    my $repodir   = "$directory/repo";
390
    my $checkin   = "$directory/checkins/$view";
391
392
    
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
393
394
395
396
    # 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). 
397
    #
398
399
400
401
    if (! -e "$checkin/$rootdir") {
	mysystem("$MKDIR $checkin/$rootdir") == 0 or return -1;
    }
    
402
403
    if (-f "/${sourcedir}/${sourcefile}" || !$exact) {
	mysystem("$TAR cf - -C /$sourcedir $sourcefile | ".
404
		 "$TAR xf - -U -C $checkin/$rootdir");
405
	mysystem("$CHMOD 775 $checkin/$rootdir/$sourcefile");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
406
407
    }
    else {
408
409
410
	mysystem("cd /$sourcedir; ".
		 "$RSYNC $rsyncopt -rtgoDlz ".
		 "  --delete ${sourcefile} $checkin/$rootdir");
411
412
    }
    if ($?) {
413
	print STDERR "ArchiveAdd: Could not copy in $pathname\n";
414
415
416
417
418
419
	return -1;
    }
    return 0;
}

#
420
421
422
423
424
# 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.
425
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
426
sub ArchiveSavePoint($;$$$)
427
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
428
    my ($archive_idx, $savetag, $view, $altdir) = @_;
429
430
431
432
433
434
435
436
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
437
438
439
440
441
442

    #
    # See if the archive exists and if it does, get the pathname to it.
    #
    my $directory;
    if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
443
	print STDERR "ArchiveSavePoint: ".
444
	    "Archive '$archive_idx' does not exist in the DB!\n";
445
	goto bad;
446
447
    }
    if (! -d $directory || ! -w $directory) {
448
	print STDERR "ArchiveSavePoint: $directory cannot be written!\n";
449
	goto bad;
450
    }
451
    my $repodir   = "$directory/repo";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
452
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
453
454
455
456
457
458

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

465
    # Get the current tag for the archive.
466
467
    my ($archive_tag);
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag) < 0) {
468
469
470
471
472
473
474
475
476
477
478
479
480
481
	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";
    }

482
    # Tags must start with a letter.
483
484
485
486
    if ($savetag =~ /^\d+/) {
	$savetag = "T" . $savetag;
    }
    
487
    #
488
    # Use svn import command. This is nice cause it handles all the
489
490
491
    # subdirs and stuff in one shot, instead of trying to deal with
    # each file and directory individually.
    #
492
493
494
495
    if (! chdir("$checkin")) {
	print STDERR "ArchiveSavePoint: Cannot chdir to $checkin!\n";
	goto bad;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
496
497
498
    # Avoid a core file from svn.
    mysystem("ulimit -c 0; $IMPORTER -no_user_input file://$repodir ".
	     "                 $view/savepoint . " .
499
	     ($debug < 2 ? "> /dev/null 2>&1" : ""))
500
501
502
503
504
	== 0 or goto bad;

    #
    # Create the tag for this savepoint. 
    # 
505
    mysystem("$SVN copy $svnopt -m 'ArchiveCreate Branch' ".
506
507
508
509
	     "          file://$repodir/$view/savepoint ".
	     "          file://$repodir/$view/tags/${savetag}")
	== 0 or goto bad;
    
510
511
512
513

    #
    # And record the new tag. 
    # 
514
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
515
		"  tag='$savetag', view='$view', ".
516
		"  archive_idx='$archive_idx', ".
517
		"  tagtype='$TAGTYPE_SAVEPOINT', ".
518
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
519

520
  okay:
521
522
523
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
524
525
526
    return 0;

  bad:
527
528
529
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
530
531
532
533
534
535
536
    return -1;
}

#
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
537
sub ArchiveCommit($;$$$$)
538
{
539
    my ($archive_idx, $newtag, $mfile, $view, $altdir) = @_;
540
    my $noactivity = 0;
541
542
543
544
545
546
547
548
    my $cwd;

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

    return -1
	if (TBScriptLock("archive_${archive_idx}", 0, 120) !=
	    TBSCRIPTLOCK_OKAY());
549
550
551
552
553
554
555
556

    #
    # 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";
557
	goto bad;
558
559
560
    }
    if (! -d $directory || ! -w $directory) {
	print STDERR "ArchiveCommit: $directory cannot be written!\n";
561
	goto bad;
562
    }
563
    my $repodir   = "$directory/repo";
564
565
    my $checkout  = "$directory/checkouts/$view";
    my $checkin   = (defined($altdir) ? $altdir : "$directory/checkins/$view");
566
567
568
569
570
571
572
573

    # 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
574
	print STDERR "ArchiveCommit: Bad data in $cwd!\n";
575
	goto bad;
576
577
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
578
579
    if (! chdir("$directory")) {
	print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
580
	goto bad;
581
582
583
    }

    # Get the current tags for the archive.
584
    my ($archive_tag, $previous_tag);
585
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
586
			      \$previous_tag) < 0) {
587
588
589
590
591
592
	print STDERR "ArchiveCommit: ".
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

    #
593
594
    # Form new tag.
    # 
595
596
597
    my ($seconds, $microseconds) = gettimeofday();
    my $import_tag  = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
    $import_tag    .= $microseconds;
598
599

    if (!defined($newtag)) {
600
	$newtag = $import_tag . "_commit";
601
602
    }

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

608
609
610
611
612
613
614
    #
    # 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 ".
615
		    "where archive_idx='$archive_idx' and view='$view' ".
616
617
618
619
620
621
622
623
624
		    "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;
    }
625
626
627
628
629
630
631
632
633
634
635
636
637

    #
    # 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";
    }
638
    
639
    #
640
641
642
    # Okay, do the commit to the trunk for this view.
    # 
    if (! $noactivity) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
643
644
645
646
647
648
649
650
651
	#
	# Create a temporary spot to work in.
	# 
	if (! mkdir("merge.$$", 0777)) {
	    print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
	    goto bad;
	}
	chdir("merge.$$");
	
652
	#
653
	# Check out the current trunk.
654
	#
655
656
657
	mysystem("$SVN checkout $svnopt file://$repodir/$view/trunk")
	    == 0 or goto bad;

658
	#
659
660
661
662
663
664
665
666
667
668
	# 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;
669

670
	mysystem("$SVN commit $svnopt $message_arg trunk")
671
	    == 0 or goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
672
673
674
675
676
677
678

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

681
    # Create a tag in the tags directory for the commit.
682
    mysystem("$SVN copy $svnopt $message_arg ".
683
684
685
686
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}")
	== 0 or goto bad;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
687
688
689
    # 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.
690
    mysystem("$SVN copy $svnopt $message_arg ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
691
692
693
694
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/history/${newtag}")
	== 0 or goto bad;
    
695
    # Create a branch tag in the tags directory to base differences against.
696
    mysystem("$SVN copy $svnopt -m 'ArchiveCommit Branch' ".
697
698
699
	     "          file://$repodir/$view/trunk ".
	     "          file://$repodir/$view/tags/${newtag}-branch")
	== 0 or goto bad;
700
701
702
703

    # For putting message into DB.
    my $dclause = (defined($mfile) ? 
		   ", description=" . DBQuoteSpecial(`cat $mfile`) : "");
704
    
705
    DBQueryWarn("insert into archive_tags set idx=NULL, ".
706
		"  tag='$newtag', view='$view', ".
707
		"  archive_idx='$archive_idx', ".
708
709
		"  tagtype='$TAGTYPE_COMMIT', ".
		"  date_created=UNIX_TIMESTAMP(now()) $dclause")
710
	or goto bad;
711

712
    DBQueryWarn("update archive_views set ".
713
		"  current_tag='$newtag', ".
714
		"  previous_tag='$archive_tag' ".
715
716
		"where archive_idx='$archive_idx' and view='$view'")
	or goto bad;
717

718
719
720
    # And now into the checkout dir to checkout a current copy.
    if (! chdir("$checkout")) {
	print STDERR "ArchiveCommit: Cannot chdir to $checkout!\n";
721
	goto bad;
722
    }
723
    mysystem("$SVN $svnopt update trunk");
724
    if ($?) {
725
	print STDERR "ArchiveCommit: Could not update head revision!\n";
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
	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.
#
746
sub ArchiveFork($$;$$$)
747
{
748
749
    my ($archive_idx, $newview, $branchtag, $newtag, $view) = @_;
    my $sourcepoint;
750
751
752
753
754
755
756
757
758
759
760
761
762
763
    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) {
764
	print STDERR "ArchiveFork: ".
765
766
767
768
	    "Archive '$archive_idx' does not exist in the DB!\n";
	goto bad;
    }
    if (! -d $directory || ! -w $directory) {
769
	print STDERR "ArchiveFork: $directory cannot be written!\n";
770
	goto bad;
771
    }
772
    my $repodir     = "$directory/repo";
773
774
775
776
777
778
779
780
781
782
783
784
785
    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
786
	print STDERR "ArchiveFork: Bad data in $cwd!\n";
787
788
789
790
	goto bad;
    }

    # Get the current tags for the archive.
791
    my ($archive_tag, $previous_tag);
792
    if (GetArchiveCurrentTags($archive_idx, $view, \$archive_tag,
793
			      \$previous_tag) < 0) {
794
	print STDERR "ArchiveFork: ".
795
796
797
798
	    "Archive '$archive_idx' does not have a current tag!\n";
	goto bad;
    }

799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
    #
    # 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;
    }

815
816
    # Create new view directories and checkout.
    if (! mkdir("$newcheckin", 0777)) {
817
	print STDERR "ArchiveFork: Could not mkdir $newcheckin: $!\n";
818
819
820
	goto bad;
    }
    if (! chmod(0777, "$newcheckin")) {
821
	print STDERR "ArchiveFork: Could not chmod $newcheckin: $!\n";
822
823
	goto bad;
    }
824
825

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

830
831
832
833
834
835
836
837
838
839
840
841
    #
    # 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;
842
    }
843
    $sourcepoint = "tags/$branchtag";
844
845
846
847
848
849
850

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

851
852
853
854
855
856
857
    # 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.
858
    mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
859
	     "          file://$repodir/$newview/history ".
860
861
862
	     "          file://$repodir/$newview/tags")
	== 0 or goto bad;

863
864
865
866
867
    # 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;
868
869
870
871
872
873
874
875

    # 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;
876
    
877
    # Now check it out. This creates the checkouts/$newview directory.
878
    mysystem("cd $checkouts; ".
879
	     "$SVN checkout $svnopt file://$repodir/$newview")
880
881
	== 0 or goto bad;

882
883
884
885
    # Now enter the newview (okay, branch) of this archive.
    DBQueryWarn("insert into archive_views set ".
		"  current_tag='$newtag', archive_idx='$archive_idx', ".
		"  view='$newview', ".
886
		"  parent_view='$view', branch_tag='$branchtag', ".
887
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
888
    
889
890
891
    # 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', ".
892
		"  tagtype='$TAGTYPE_INTERNAL', ".
893
		"  view='$newview', ".
894
		"  date_created=UNIX_TIMESTAMP(now())") or goto bad;
895

896
  okay:
897
898
899
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
900
    return 0;
901
902

  bad:
903
904
905
    TBScriptUnlock();
    chdir($cwd)
	if (defined($cwd));
906
    return -1;
907
908
}

909
910
911
#
# Checkout a copy of the archive, optionally at a particular view/branch.
#
912
sub ArchiveCheckout($$;$$$)
913
{
914
    my ($archive_idx, $target, $view, $tag, $subdir) = @_;
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
    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"
    }
973
974
975
    # Allowed to check out a particular subdir (but not a file).
    $sourcepoint = $sourcepoint . "/$subdir"
	if (defined($subdir));
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993

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

994
995
996
997
998
#
# 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.
#
999
sub ArchiveArchive($)
1000
{
For faster browsing, not all history is shown. View entire blame