1083 lines
32 KiB
Perl
1083 lines
32 KiB
Perl
# FileName: PopulateFromVBL.pl
|
|
#
|
|
# Have any changes to this file reviewed by DavePr, BryanT, or WadeLa
|
|
# before checking in.
|
|
# Any changes need to verified in all standard build/rebuild scenarios.
|
|
#
|
|
# Usage = PopulateFromVBL.pl [-force] [-vbl=vblreleasedir] [-nttree=nttreedir] [-symbols]
|
|
#
|
|
# Function: Populate missing files in nttreedir from vblreleaseddir so
|
|
# 0) Verify that binplacedir and VBL are (compatible?) release directories
|
|
# 1) Find the binplace.log output for both paths
|
|
# 2) Figure out what projects were built in the nttree
|
|
# 3) Generate a list of files that were built on VBL for the projectlist
|
|
# 4) Output a list of files we should have built locally, but didn't
|
|
# 5) If (4) is empty, or -force, populate missing files in nttreedir
|
|
# from vblreleaseedir forall projects
|
|
#
|
|
# No files in nttreedir are overwritten from vblreleasedir
|
|
# The checks for what should be there are not exact, because we rely only on
|
|
# binplace.log entries -- and the VBL build may not exactly match the nttree build.
|
|
#
|
|
# [-force] -- do copying even if the nttree doesn't contain project files built in VBL
|
|
# [-verbose] -- chatter while working
|
|
# [-fake] -- don't do the actual copies
|
|
# [-checkbinplace] -- note VBL files that are in binplace.log but not build.binlist
|
|
# [-fulltargetok] -- run even if the target machine has built in all projects
|
|
#
|
|
#
|
|
# VBLpath will be computed from BuildMachines.txt if not supplied either
|
|
# on the command line, or in the VBL_RELEASE environment variable.
|
|
#
|
|
# If we are a build lab, we succeed without doing much.
|
|
#
|
|
|
|
# WARNING:
|
|
# WARNING: make sure pathname comparisons are case insensitive. Either convert the case or do the
|
|
# WARNING: comparisons like this:
|
|
# WARNING: if ($foo =~ /^\Q$bar\E$/i) {}
|
|
# WARNING: or if ($foo !~ /^\Q$bar\E$/i) {}
|
|
# WARNING:
|
|
|
|
#
|
|
# BUGBUG: Still need to copy down the compressed directory, per Wade's request...
|
|
# ... but I'm really hoping that this will translate into an opportunity not
|
|
# ... to copy down the uncompressed version from the VBL... Or, as MarkL suggested,
|
|
# ... I should uncompress the compressed version rather than copy it. I'd need to
|
|
# ... validate this, maybe in postbuild on the VBL?
|
|
|
|
|
|
$begintime = time();
|
|
|
|
$VBLPathVariableName = 'VBL_RELEASE';
|
|
$BuildMachinesFile = $ENV{ "RazzleToolPath" } . "\\BuildMachines.txt";
|
|
$SdDotMapPathname = "sd.map";
|
|
$LogFile = "build.populate";
|
|
$BinListFile = "build.binlist";
|
|
$TestFileName = "build.testpopulate";
|
|
$CDDATAFileName = "cddata.txt";
|
|
|
|
#
|
|
# Build the complete list of non-root projects
|
|
#
|
|
@Projects = (public, mergedcomponents, tools,
|
|
admin, base, com, drivers, ds, enduser, inetcore, inetsrv,
|
|
multimedia, net, printscan, sdktools, shell, termsrv, windows);
|
|
|
|
for (@Projects) {
|
|
$Project{$_} = 1;
|
|
}
|
|
|
|
#
|
|
# Projects that aren't really projects, but might be found in the binplace log and should just be ignored.
|
|
#
|
|
@PseudoProjects = ("pre-bbt");
|
|
|
|
for (@PseudoProjects) {
|
|
$PseudoProject{$_} = 1;
|
|
}
|
|
|
|
#
|
|
# MagicPrefixes are places where VBLs (or notably main) build things not under SDXROOT
|
|
#
|
|
@MagicRoots = (bbt_return);
|
|
|
|
for (@MagicRoots) {
|
|
$MagicRoot{$_} = 1;
|
|
}
|
|
|
|
#
|
|
# Usage variables
|
|
#
|
|
$PGM='PopulateFromVBL: ';
|
|
|
|
$Usage = $PGM . "Usage: PopulateFromVBL.pl [-force] [-vbl=vblreleasedir] [-nttree=nttreedir] [-symbols]\n";
|
|
|
|
#
|
|
# Get the current directory
|
|
#
|
|
open CWD, 'cd 2>&1|';
|
|
$CurrDir = <CWD>;
|
|
close CWD;
|
|
chomp $CurrDir;
|
|
|
|
$CurrDrive = substr($CurrDir, 0, 2);
|
|
|
|
#
|
|
# Check variables expected to be set in the environment.
|
|
#
|
|
$sdxroot = $ENV{'SDXROOT'} or die $PGM, "Error: SDXROOT not set in environment\n";
|
|
$buildarch = $ENV{'_BuildArch'} or die $PGM, "Error: _BuildArch not set in environment\n";
|
|
$computername = $ENV{'COMPUTERNAME'} or die $PGM, "Error: COMPUTERNAME not set in environment\n";
|
|
$branchname = $ENV{'_BuildBranch'} or die $PGM, "Error: _BuildBranch not set in environment\n";
|
|
|
|
$foo = $ENV{'NTDEBUG'} or die $PGM, "Error: NTDEBUG not set in environment\n";
|
|
$dbgtype = 'chk';
|
|
$dbgtype = 'fre' if $foo =~ /nodbg$/i;
|
|
|
|
#
|
|
# initialize argument variables
|
|
#
|
|
$Fake = $ENV{'POPULATEFROMVBL_FAKE'};
|
|
$Verbose = $ENV{'POPULATEFROMVBL_VERBOSE'};
|
|
$Compare = $ENV{'POPULATEFROMVBL_COMPARE'};
|
|
$Progress = $ENV{'POPULATEFROMVBL_PROGRESS'};
|
|
$Test = $ENV{'POPULATEFROMVBL_TEST'};
|
|
$Symbols = $ENV{'POPULATEFROMVBL_SYMBOLS'};
|
|
$SkipPats = $ENV{'POPULATEFROMVBL_SKIP'};
|
|
$CDDataOnly = $ENV{'POPULATEFROMVBL_CDDATAONLY'};
|
|
|
|
$Force = 0;
|
|
$FullTargetOk = 0;
|
|
|
|
$CheckBinplace = 0;
|
|
|
|
#
|
|
# Debug routines for printing out variables
|
|
#
|
|
sub gvar {
|
|
for (@_) {
|
|
print "\$$_ = $$_\n";
|
|
}
|
|
}
|
|
|
|
#
|
|
# print on the various files
|
|
#
|
|
sub printall {
|
|
print TSTFILE @_ if $Test;
|
|
print LOGFILE @_;
|
|
print $PGM unless @_ == 1 and @_[0] eq "\n";
|
|
print @_;
|
|
}
|
|
|
|
sub printfall {
|
|
printf TSTFILE @_ if $Test;
|
|
printf LOGFILE @_;
|
|
print $PGM unless @_ == 1 and @_[0] eq "\n";
|
|
printf @_;
|
|
}
|
|
|
|
#
|
|
# Sub hms
|
|
# Takes Argument time in seconds and returns as list of (hrs, mins, secs)
|
|
#
|
|
sub hms {
|
|
$s = shift @_;
|
|
$h = int ($s / 3600);
|
|
$s -= 3600*$h;
|
|
$m = int ($s / 60);
|
|
$s -= 60*$m;
|
|
|
|
return ($h, $m, $s);
|
|
}
|
|
|
|
|
|
#
|
|
# signal catcher (at least this would work on unix)
|
|
#
|
|
sub catch_ctrlc {
|
|
printall "Aborted.\n";
|
|
die $PGM, "Error: Aborted.\n";
|
|
}
|
|
|
|
$SIG{INT} = \&catch_ctrlc;
|
|
|
|
#
|
|
# routine to fully qualify a pathname
|
|
#
|
|
sub fullyqualify {
|
|
die $PGM . "Error: Internal error in fullpathname().\n" unless @_ == 1;
|
|
$_ = @_[0];
|
|
|
|
if (/\s/) { die $PGM, "Error: Spaces in pathnames not allowed: '", $_, "'\n"; }
|
|
|
|
return $_ unless $_; # empty strings are a noop
|
|
|
|
s/([^:])\\$/$1/; # get rid of trailing \
|
|
|
|
while (s/\\\.\\/\\/) {} # get rid of \.\
|
|
while (s/\\[^\\]+\\\.\.\\/\\/) {} # get rid of \foo\..\
|
|
|
|
s/\\[^\\]+\\\.\.$/\\/; # get rid of \foo\..
|
|
s/:[^\\]+\\\.\.$/:/; # get rid of x:foo\..
|
|
s/([^:])\\\.$/$1/; # get rid of foo\.
|
|
s/:\\\.$/:\\/; # get rid of x:\.
|
|
s/:[^\\]+\\\.\.$/:/; # get rid of x:foo\..
|
|
|
|
s/^$CurrDrive[^\\]/$CurrDir\\/i; # convert drive-relative on current drive
|
|
|
|
if (/^[a-z]:\\/i) { return $_; } # full
|
|
if (/^\\[^\\].*/) { return "$CurrDrive$_"; } # rooted
|
|
if (/^\\\\[^\\]/) {
|
|
# print $PGM, 'Warning: Use of UNC name bypasses safety checks: ', $_, "\n";
|
|
return $_; # UNC
|
|
}
|
|
|
|
if (/^\.$/) { return "$CurrDir"; } # dot
|
|
if (/^$CurrDrive\.$/i) { return "$CurrDir"; } # dot on current drive
|
|
|
|
if (/^[^\\][^:].*/i) { return "$CurrDir\\$_"; } # relative
|
|
|
|
if (/^([a-z]:)([^\\].*)/i) { $drp = $CurrDir; # this case handled above
|
|
if ($1 ne $CurrDir) {
|
|
# $drp = $ENV{"=$1"}; # doesn't work!
|
|
die $PGM, "Error: Can't translate drive-relative pathnames: ", $_, "\n";
|
|
}
|
|
return "$drp\\$2"; # drive:relative
|
|
}
|
|
|
|
die $PGM, "Error: Unrecognized pathname format: $_\n";
|
|
}
|
|
|
|
#
|
|
# Routine for exploding directory names into a list of components (for mkdir)
|
|
#
|
|
sub explodedir {
|
|
my(@explodelist) = ();
|
|
my(@components);
|
|
my($path);
|
|
|
|
for (@_) {
|
|
$_ = shift;
|
|
@components = split /\\/;
|
|
push @components, "";
|
|
$path = shift @components;
|
|
for (@components) {
|
|
push @explodelist, $path;
|
|
$path = $path . "\\" . $_;
|
|
}
|
|
}
|
|
|
|
return @explodelist;
|
|
}
|
|
|
|
#
|
|
# Routine to copy a file -- avoiding win32::CopyFile
|
|
#
|
|
# BUGBUG: This doesn't work. sysread() seems broken.
|
|
#
|
|
#
|
|
|
|
use Fcntl;
|
|
|
|
sub populatecopy {
|
|
my $writesize = 64*4096;
|
|
|
|
my($src, $dst) = @_;
|
|
my($infile, $outfile, $buf, $n, $r, $o);
|
|
|
|
if (not sysopen INFILE, $src, O_RDONLY() | O_BINARY()) {
|
|
return 0;
|
|
}
|
|
|
|
if (not sysopen OUTFILE, $dst, O_WRONLY() | O_CREAT() | O_TRUNC() | O_BINARY(), 0666) {
|
|
close INFILE;
|
|
return 0;
|
|
}
|
|
|
|
$r = 0; # need this to be defined in case INFILE is empty
|
|
|
|
ERR: while ($n = sysread INFILE, $buf, $writesize) {
|
|
last ERR unless defined $n;
|
|
|
|
$o = 0;
|
|
while ($n) {
|
|
$r = syswrite OUTFILE, $buf, $n, $o;
|
|
last ERR unless defined $r;
|
|
|
|
$n -= $r;
|
|
$o += $r;
|
|
}
|
|
}
|
|
|
|
close INFILE;
|
|
close OUTFILE;
|
|
|
|
return 0 if not defined $n or not defined $r or $n != 0;
|
|
return 1;
|
|
}
|
|
|
|
use File::Copy;
|
|
use File::Compare;
|
|
|
|
|
|
#
|
|
# Process and validate arguments
|
|
#
|
|
for (@ARGV) {
|
|
if (/^[\/\-]test$/i) { $Test++; next; }
|
|
if (/^[\/\-]verbose$/i) { $Verbose++; next; }
|
|
if (/^[\/\-]cddataonly$/i) { $CDDataOnly++; next; }
|
|
if (/^[\/\-]compare$/i) { $Compare++; next; }
|
|
if (/^[\/\-]symbols$/i) { $Symbols++; next; }
|
|
if (/^[\/\-]force$/i) { $Force++; next; }
|
|
if (/^[\/\-]fake$/i) { $Fake++; next; }
|
|
if (/^[\/\-]fulltargetok$/i) { $FullTargetOk++; next; }
|
|
if (/^[\/\-]vbl=(.+)$/i) { $VBL = $1; next; }
|
|
if (/^[\/\-]nttree=(.+)$/i) { $NTTree = $1; next; }
|
|
|
|
if (/^[\/\-]skip=(.+)$/i) { $SkipPats .= "$1;"; next; }
|
|
|
|
if (/^[\/\-]?$/i) { die $Usage; }
|
|
if (/^[\/\-]help$/i) { die $Usage; }
|
|
|
|
if (/^[\/\-]checkbinplace$/i) { $CheckBinplace++; next; }
|
|
|
|
die $Usage;
|
|
}
|
|
|
|
#
|
|
# If we didn't get the NTTree directory from the command line,
|
|
# get it from the _NTTREE environment variable.
|
|
#
|
|
|
|
$NTTree = $ENV{'_NTTREE'} unless $NTTree;
|
|
|
|
#
|
|
# Can only populate with the current directory the same as sdxroot.
|
|
#
|
|
die $PGM, "Error: Can only populate if CD <$CurrDir> is SDXROOT <$sdxroot>\n" unless $sdxroot =~ /^\Q$CurrDir\E$/io;
|
|
$rc = system "perl $sdxroot\\tools\\CombineDistributedBinplaceLogs.pl -nttree=$NTTree";
|
|
die $PGM, "Error: CombineDistributedBinplaceLogs.pl failed.\n" if $rc;
|
|
#
|
|
# We always need to build a current binlist file -- unless it already exists.
|
|
#
|
|
$foo = "Creating binlist file with dir command.\n";
|
|
print $PGM, $foo;
|
|
|
|
$NTTreeBinListFile = "$NTTree\\build_logs\\$BinListFile";
|
|
if (! -s $NTTreeBinListFile) {
|
|
$rc = system "dir /b/s /a-d %_NTTREE% > $NTTreeBinListFile";
|
|
die $PGM, "Error: Error building $NTTreeBinListFile: $!\n" if $rc;
|
|
}
|
|
|
|
#
|
|
# If we didn't get the local target directory from the command line,
|
|
# get it from the environment. If that fails, we parse BuildMachines.txt.
|
|
#
|
|
# Since BuildMachines.txt doesn't define the VBL directory for IDX builds
|
|
# correctly (it points to latest.tst), let's define the VBL share for IDX builds
|
|
# based on $(sdxroot)\__bldnum__.
|
|
#
|
|
$VBL = $ENV{$VBLPathVariableName} unless $VBL;
|
|
|
|
#
|
|
#if IDX build
|
|
if ((not $VBL) && ($branchname =~ /^idx[0][1-3]$/i)) {
|
|
print $PGM, "Working with IDX branch --- $branchname\n";
|
|
$BldNumFile = "$sdxroot\\__bldnum__";
|
|
open BLDFILE, "$BldNumFile" or die print $PGM, "Error: Could not open BldNumFile: $BldNumFile\n";
|
|
|
|
for (<BLDFILE>) {
|
|
s/\s+//g;
|
|
($text, $bld) = split /=/;
|
|
}
|
|
|
|
print $PGM, "IDX build ($branchname branch) corresponds to $bld build\n";
|
|
|
|
$VBL="\\\\ntdev\\release\\main\\usa\\$bld\\$buildarch$dbgtype\\bin";
|
|
print $PGM, "VBL = $VBL\n";
|
|
close BLDFILE;
|
|
}
|
|
|
|
if ((not $VBL) || ($VBL =~ /^[\d\w_]+$/)) {
|
|
$tbranchname = $branchname;
|
|
$tbranchname = $VBL if $VBL =~ /^[\d\w_]+$/;
|
|
$fname = $BuildMachinesFile;
|
|
open BMFILE, $fname or die $PGM, "Error: Could not open: $fname\n";
|
|
|
|
for (<BMFILE>) {
|
|
s/\s+//g;
|
|
s/;.*$//;
|
|
next if /^$/;
|
|
($vblmach, $vblprime, $vblbranch, $vblarch, $vbldbgtype, $vbldl, $disttype, $alt_release ) = split /,/;
|
|
|
|
#
|
|
#BUGBUG:
|
|
# Should this really come through the environment
|
|
# variable that declares this to be a VBL?
|
|
#
|
|
if ($vblmach =~ /\Q$computername\E/io) {
|
|
print $PGM, "Skipping populate because this is a VBL machine.\n";
|
|
exit 0;
|
|
}
|
|
|
|
if ($vblarch =~ /\Q$buildarch\E/io and $vbldbgtype =~ /\Q$dbgtype\E/io
|
|
and $vblbranch =~ /\Q$tbranchname\E/io
|
|
and $disttype !~ /distbuild/i) {
|
|
if ( defined $alt_release) {
|
|
$VBL = $alt_release;
|
|
last;
|
|
}
|
|
else {
|
|
$dname = "\\\\$vblmach\\release";
|
|
}
|
|
|
|
opendir BDIR, "$dname\\" or die $PGM, "Error: Could not open directory: $dname\n";
|
|
@reldirs = readdir BDIR;
|
|
close BDIR;
|
|
|
|
$rname = 0;
|
|
$date = 0;
|
|
for (@reldirs) {
|
|
next unless /[0-9]+\.$vblarch$vbldbgtype\.$vblbranch\.(.+)$/io;
|
|
($date = $1, $rname = $_) unless $date gt $1
|
|
or substr($date, 0, 2) eq '00' and substr($1, 0, 2) eq '99'; # Y2K trade-off
|
|
|
|
}
|
|
|
|
if (not $rname) {
|
|
print $PGM, "Warning: No valid release shares found on $dname.\n";
|
|
} else {
|
|
$VBL = "$dname\\$rname";
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
|
|
close BMFILE;
|
|
}
|
|
|
|
|
|
die $PGM, "Error: Not a directory: ", $VBL, "\n" if $VBL and ! -d $VBL;
|
|
|
|
die $Usage unless $NTTree;
|
|
die $PGM, "Error: Not a directory: ", $NTTree, "\n" unless -d $NTTree;
|
|
die $PGM, "Error: Not writable: ", $NTTree, "\n" unless -w $NTTree;
|
|
|
|
$SkipPats =~ tr/@/^/;
|
|
$SkipPats =~ s/;;+/;/g;
|
|
$SkipPats =~ s/\\/\\\\/g;
|
|
$SkipPats =~ s/\\\\\./\\./g;
|
|
$SkipPats =~ s/^;//;
|
|
$SkipPats =~ s/;$//;
|
|
@SkipPatterns = split /;/, $SkipPats if $SkipPats;
|
|
|
|
#
|
|
# Fully qualify the pathnames
|
|
#
|
|
$VBL = fullyqualify($VBL) if $VBL;
|
|
$NTTree = fullyqualify($NTTree);
|
|
|
|
#
|
|
# Open the logfile, and maybe the testfile
|
|
#
|
|
$foo = "$NTTree\\build_logs\\$LogFile";
|
|
open LOGFILE, ">>$foo" or die $PGM, "Error: Could not create logfile: ", $foo, ": $!\n";
|
|
|
|
open TSTFILE, ">$TestFileName" or die $PGM, "Error: Could not create testfile: ", $TestFileName, ": $!\n" if $Test;
|
|
|
|
#
|
|
# Verify that VBL and NTTree are compatible release directories
|
|
# BUGBUG:
|
|
# For now, this just means ensure they both have build_logs directories.
|
|
# It might be nice to check that the builds are from the same branch, and the same main branch build, but ...
|
|
#
|
|
|
|
die $PGM . "Error: The nttree build_logs not found.\n" unless -d "$NTTree\\build_logs\\.";
|
|
|
|
if ($VBL) {
|
|
die $PGM . "Error: The VBL build_logs not found.\n" unless -d "$VBL\\build_logs\\.";
|
|
printall "Populating $NTTree from VBL $VBL\n";
|
|
}
|
|
|
|
#
|
|
# Process the CDDATA file to build a real copylist.
|
|
#
|
|
# BUGBUG: I put the code in to do this (if the flag is set), but
|
|
# I don't understand how Wade and Mike thought I could use
|
|
# this data to automatically trim what gets copied from the VBL.
|
|
#
|
|
if ($VBL) {
|
|
$CDDATAFileName = "$VBL\\build_logs\\$CDDATAFileName";
|
|
printall $PGM . "Warning: Could not open $CDDATAFileName: $!\n" unless -r $CDDATAFileName;
|
|
|
|
@CDData = ();
|
|
|
|
if ($CDDataOnly) {
|
|
open CDDATA, $CDDATAFileName or die $PGM, "Error: Could not open: ", $CDDATAFileName, ": $!\n";
|
|
for (<CDDATA>) {
|
|
chomp;
|
|
s/\s+//g;
|
|
s/;.*//;
|
|
next if /^$/;
|
|
($name, $signed, $prodlist, $iscompressed, $isdriver, $isprinter, $dosnet)
|
|
= /(.*)=([tf]):([a-z]+):([tf]):([tf]):([tf]):([tf])/;
|
|
|
|
printall $PGM . "WARNING: failed to parse cddata line: $_\n" unless $name;
|
|
next unless $name;
|
|
|
|
$CDData{$name}++;
|
|
}
|
|
close CDDATA;
|
|
}
|
|
}
|
|
|
|
#
|
|
# Alert that we are skipping certain classes of files
|
|
#
|
|
printall "Skipping various symbols directories.\n" unless $Symbols;
|
|
printall "Skipping delayload directory.\n";
|
|
printall "Skip Patterns:\n";
|
|
for (@SkipPatterns) {
|
|
$pat = $_;
|
|
$pat =~ s/\\\\/\\/g;
|
|
printall "Skip /$pat/\n";
|
|
}
|
|
|
|
|
|
#
|
|
# BUGBUG:
|
|
# At some point, there will be a file in build_logs which we tell use
|
|
# interesting details about a build. We will want to dump out the contents
|
|
# of this file for both VBL and NTTree, so the user can see what they
|
|
# are getting themselves into.
|
|
#
|
|
|
|
|
|
#
|
|
# Read in the VBL and NTTree binplace logs and process them
|
|
#
|
|
open BINPLACE, "$NTTree\\build_logs\\binplace.log"
|
|
#or open BINPLACE, "$NTTree\\binplace.log"
|
|
or die $PGM, "Error: Could not open: ", "$NTTree\\build_logs\\binplace.log", "\n";
|
|
|
|
$nignored = 0;
|
|
|
|
for (<BINPLACE>) {
|
|
$whichline++;
|
|
tr/A-Z/a-z/;
|
|
|
|
$skipline = 0;
|
|
|
|
# First test skips case where NTTree is under SDXROOT and there are binplace records (thanks to SCP)
|
|
if (/^\Q$NTTree\E\\/io) {
|
|
$skipline = 1;
|
|
} elsif (/^\Q$sdxroot\E\\([^\\]+)\\([^\s]+)\\([^\\\s]*)\s+\t/io) {
|
|
$project=$1; $relpath=$2; $filename=$3;
|
|
} else {
|
|
$skipline = 1;
|
|
}
|
|
|
|
if ($skipline) {
|
|
print TSTFILE "Ignored TARG binplace record at line $whichline: ", $_ if $Test;
|
|
|
|
$nignored++;
|
|
if ($Verbose && $nignored <= 10) {
|
|
print LOGFILE $PGM . "Ignored TARG binplace record at line $whichline: ", $_;
|
|
print LOGFILE $PGM . "...\n" if $nignored == 10;
|
|
}
|
|
next;
|
|
}
|
|
|
|
$project =~ tr/A-Z/a-z/;
|
|
$relpath =~ tr/A-Z/a-z/;
|
|
$filename =~ tr/A-Z/a-z/;
|
|
|
|
if (not $Project{$project} and not $PseudoProject{$project}) {
|
|
$msg = $PGM . "Error: NTTREE: unknown project '$project' at line $whichline: $_\n";
|
|
if ($Fake) { warn $msg; } else { die $msg; }
|
|
next;
|
|
}
|
|
|
|
$TargCounts{$project}++;
|
|
push @{"T_" . $project . "_binplaced"}, "$relpath\\$filename";
|
|
}
|
|
close BINPLACE;
|
|
|
|
if ($Verbose) {
|
|
$total = 0;
|
|
printall "\n";
|
|
printall "NTTree project counts\n";
|
|
for (@Projects) {
|
|
printfall " %5d %s\n", $TargCounts{$_}, $_;
|
|
$total += $TargCounts{$_};
|
|
}
|
|
printall "-----------------\n";
|
|
printfall " %5d TOTAL\n", $total;
|
|
printfall " %5d records ignored\n\n", $nignored if $nignored;
|
|
}
|
|
|
|
#
|
|
# If files have been binplaced in all the projects, we assume all projects are built locally, and
|
|
# don't try to populate -- unless explictly told to do so by the -fulltargetbuildok
|
|
#
|
|
if (not $FullTargetOk) {
|
|
|
|
$TargetIsFullBuild = 1;
|
|
for (@Projects) {
|
|
next if /public/;
|
|
next if $TargCounts{$_};
|
|
|
|
$TargetIsFullBuild = 0;
|
|
}
|
|
|
|
if ($TargetIsFullBuild) {
|
|
printall "Not run because $NTTree should be a full build of all projects.\n";
|
|
|
|
close LOGFILE;
|
|
close TSTFILE if $Test;
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
die $PGM, "Error: There was trouble finding a VBL.\n" unless $VBL;
|
|
|
|
|
|
open BINPLACE, "$VBL\\build_logs\\binplace.log"
|
|
#or open BINPLACE, "$VBL\\binplace.log"
|
|
or die $PGM, "Error: Could not open: ", "$VBL\\build_logs\\binplace.log", "\n";
|
|
|
|
$nignored = 0;
|
|
$whichline = 0;
|
|
|
|
for (<BINPLACE>) {
|
|
$whichline++;
|
|
tr/A-Z/a-z/;
|
|
|
|
#
|
|
# BUGBUG: assumes all VBLs build under an sdxroot something like x:\foo
|
|
#
|
|
if (/^[a-z]:\\([^\\]+)\\([^\\]+)\\([^\s]+)\\([^\\\s]*)\s+\t/io) { $rootname=$1; $project=$2; $relpath=$3; $filename=$4; }
|
|
else {
|
|
print TSTFILE "Ignored VBL binplace record at line $whichline: ", $_ if $Test;
|
|
|
|
$nignored++;
|
|
if ($Verbose && $nignored <= 10) {
|
|
print LOGFILE $PGM, "Ignored VBL binplace record at line $whichline: ", $_;
|
|
print LOGFILE $PGM, "...\n" if $nignored == 10;
|
|
}
|
|
next;
|
|
}
|
|
|
|
$project =~ tr/A-Z/a-z/;
|
|
$relpath =~ tr/A-Z/a-z/;
|
|
$filename =~ tr/A-Z/a-z/;
|
|
|
|
die $PGM . "Error: VBL: unknown project at line $whichline: " . $_ . "\n" unless $MagicRoot{$rootname} or $Project{$project} or $PseudoProject{$project};
|
|
|
|
$VBLCounts{$project}++;
|
|
push @{"V_" . $project . "_binplaced"}, "$relpath\\$filename";
|
|
}
|
|
close BINPLACE;
|
|
|
|
#
|
|
# Check that VBL built stuff everywhere, except maybe 'public'.
|
|
#
|
|
for (@Projects) {
|
|
next if /public/;
|
|
|
|
if (not $VBLCounts{$project}) {
|
|
printall "VBL did not build anything in ", $_, "\n";
|
|
$fatal++;
|
|
}
|
|
}
|
|
|
|
if ($Verbose or $fatal) {
|
|
$total = 0;
|
|
printall "\n";
|
|
printall "VBL project counts\n";
|
|
for (@Projects) {
|
|
printfall " %5d %s\n", $VBLCounts{$_}, $_;
|
|
$total += $VBLCounts{$_};
|
|
}
|
|
printall "-----------------\n";
|
|
printfall " %5d TOTAL\n", $total;
|
|
printfall " %5d records ignored\n\n", $nignored if $nignored;
|
|
}
|
|
|
|
die $PGM, "Error: VBL release seems bad.\n" if $fatal;
|
|
|
|
#
|
|
# Analyze what got built on the VBL versus the local tree
|
|
#
|
|
# For each project that we built locally, see if there are any files
|
|
# in the VBL tree that we are missing.
|
|
#
|
|
|
|
$NotLocallyPlaced = 0;
|
|
%VBLhash = ();
|
|
%Targhash = ();
|
|
|
|
for (@Projects) {
|
|
next if /public/ or not $TargCounts{$_};
|
|
|
|
$project = $_;
|
|
|
|
#
|
|
# Build a hash table for the VBL files, and check target files.
|
|
# and vice-versa...
|
|
#
|
|
for (@{"V_" . $project . "_binplaced"}) {
|
|
$VBLhash{$_} = 1;
|
|
}
|
|
|
|
for (@{"T_" . $project . "_binplaced"}) {
|
|
printall 'Warning: non-VBL file binplaced on target: ', $_, "\n" unless $VBLhash{$_};
|
|
$Targhash{$_} = 1;
|
|
}
|
|
|
|
for (@{"V_" . $project . "_binplaced"}) {
|
|
next if $Targhash{$_};
|
|
|
|
printall 'WARNING: VBL file not binplaced on target: ', $_, "\n";
|
|
$NotLocallyPlaced++;
|
|
}
|
|
}
|
|
|
|
if ($NotLocallyPlaced and not $Force) {
|
|
die $PGM, "Error: ", $NotLocallyPlaced, " binplaced VBL files were not binplaced into ", $NTTree, "\n";
|
|
}
|
|
|
|
#
|
|
# Thats the checks. Now we just have to do the actual populate.
|
|
#
|
|
|
|
#
|
|
# Do a directory listing
|
|
# Build build.binlist for NTTREE
|
|
# Read in the build.binlist files for NTTree.
|
|
# Read in the build.binlist files for the VBL.
|
|
#
|
|
open BINLIST, "$NTTreeBinListFile"
|
|
or die $PGM, "Error: Could not open: ", "$NTTreeBinListFile", "\n";
|
|
|
|
$whichline = 0;
|
|
for (<BINLIST>) {
|
|
#
|
|
#
|
|
$whichline++;
|
|
tr/A-Z/a-z/;
|
|
chomp;
|
|
|
|
if (/^\Q$NTTree\E\\([^\s]*)$/io) {
|
|
|
|
$relpath = $1;
|
|
|
|
#
|
|
# ignore symbol and other directories
|
|
#
|
|
if (not $Symbols) {
|
|
next if /\\symbolcd\\/i;
|
|
next if /\\symbols\.pri\\/i;
|
|
next if /\\symbols\\/i;
|
|
next if /\\scp_wpa\\/i;
|
|
|
|
# instead we use $SkipPatterns
|
|
# next if $relpath =~ /^mstools\\/i;
|
|
# next if $relpath =~ /^idw\\/i;
|
|
# next if $relpath =~ /^dump\\/i;
|
|
# next if $relpath =~ /^clients\\/i;
|
|
}
|
|
|
|
#
|
|
# ignore delayload directory
|
|
#
|
|
next if /\\delayload\\/i;
|
|
|
|
#
|
|
# ignore HelpAndSupportServices directory
|
|
#
|
|
next if /\\HelpAndSupportServices\\/i;
|
|
|
|
#
|
|
# ignore paths that match skip patterns
|
|
#
|
|
$skiphit = 0;
|
|
for (@SkipPatterns) {
|
|
$skiphit = $relpath =~ /$_/i;
|
|
$spat = $_;
|
|
last if $skiphit;
|
|
}
|
|
print TSTFILE "TARG: skipping $relpath\n" if $Test and $skiphit;
|
|
next if $skiphit;
|
|
|
|
$TargFileList{$relpath} = 1;
|
|
|
|
} else {
|
|
$fatal++;
|
|
printall "Could not parse target build.binplace at line ", $whichline, ": ", $_, "\n";
|
|
}
|
|
}
|
|
close BINLIST;
|
|
|
|
#
|
|
# BUGBUG... in a few releases these will all be in build_logs
|
|
#
|
|
$foo = "$VBL\\build_logs\\$BinListFile";
|
|
open BINLIST, $foo
|
|
or open BINLIST, "$VBL\\$BinListFile"
|
|
or die $PGM, "Error: Could not open: ", $foo, "\n";
|
|
|
|
$whichline = 0;
|
|
for (<BINLIST>) {
|
|
$whichline++;
|
|
tr/A-Z/a-z/;
|
|
chomp;
|
|
|
|
if (/^[a-z]:\\[^\\]+\\([^\s]*)$/io) {
|
|
|
|
$relpath = $1;
|
|
|
|
#
|
|
# skip log files found in VBL.
|
|
#
|
|
next if /\\build\.[^\\]+$/i;
|
|
next if /\\build_logs\\/i;
|
|
|
|
#
|
|
# ignore symbol directories
|
|
#
|
|
if (not $Symbols) {
|
|
next if /\\symbolcd\\/i;
|
|
next if /\\symbols\.pri\\/i;
|
|
next if /\\symbols\\/i;
|
|
|
|
# instead we use $SkipPatterns
|
|
# next if $relpath =~ /^mstools\\/i;
|
|
# next if $relpath =~ /^idw\\/i;
|
|
# next if $relpath =~ /^dump\\/i;
|
|
# next if $relpath =~ /^clients\\/i;
|
|
}
|
|
|
|
#
|
|
# ignore delayload directory
|
|
#
|
|
next if /\\delayload\\/i;
|
|
|
|
#
|
|
# ignore HelpAndSupportServices directory
|
|
#
|
|
next if /\\HelpAndSupportServices\\/i;
|
|
|
|
#
|
|
# ignore paths that match skip patterns
|
|
#
|
|
$skiphit = 0;
|
|
for (@SkipPatterns) {
|
|
$skiphit = $relpath =~ /$_/i;
|
|
$spat = $_;
|
|
last if $skiphit;
|
|
}
|
|
print TSTFILE "VBL: skipping $relpath\n" if $Test and $skiphit;
|
|
next if $skiphit;
|
|
|
|
$VBLFileList{$relpath} = 1;
|
|
|
|
} else {
|
|
$fatal++;
|
|
printall "Could not parse VBL build.binplace at line ", $whichline, ": ", $_, "\n";
|
|
}
|
|
}
|
|
close BINLIST;
|
|
|
|
die $PGM, "Error: Fatal error parsing build.binplace.\n" if $fatal;
|
|
|
|
|
|
#
|
|
# Optionally note VBL files that were not binplaced.
|
|
#
|
|
if ($CheckBinplace) {
|
|
printall "Checking non-binplaced VBL files\n";
|
|
for (@VBLFileList) {
|
|
next unless $VBLhash{$_};
|
|
printall "Info: Non-binplaced VBL file: ", $_, "\n";
|
|
}
|
|
}
|
|
|
|
if ($Test) {
|
|
print TSTFILE "#VBLhash=", scalar keys %VBLhash, " #Targhash=", scalar keys %Targhash, "\n";
|
|
print TSTFILE "#VBLFileList=", scalar keys %VBLFileList, " #TargFileList=", scalar keys %TargFileList, "\n";
|
|
}
|
|
|
|
|
|
#
|
|
# Generate list of files to copy (i.e. every file in VBLFileList not in TargFileList).
|
|
#
|
|
printall "FAKING -- NO COPYING ACTUALLY BEING DONE\n" if $Fake;
|
|
$preptime = time();
|
|
|
|
$TotalCount = scalar keys %VBLFileList;
|
|
$ToCopy = $TotalCount - keys %TargFileList;
|
|
|
|
if ($TotalCount < 1000 or $ToCopy < 0) {
|
|
printall "ERROR: Something wrong with VBL build.binlist -- only $TotalCount files.\n";
|
|
exit 1;
|
|
}
|
|
|
|
$CopyCount = 0;
|
|
$NonCopyCount = 0;
|
|
$CopyBytes = 0;
|
|
|
|
# 12/28/2000 - added by jonwis
|
|
#
|
|
# Special code for SxS goop:
|
|
# - Copies down the vbl's binplace logs to $NTTree\\build_logs\\$(binplace file name root)-vbl.log-sxs
|
|
# This ensures that the sxs wfp updating code will actually pick up the vbl's binplaced assemblies
|
|
# as well as assemblies that the user has created.
|
|
# Add an extra backslash if the $VBL macro starts with \\. Otherwise, glob won't find the files.
|
|
$_=$VBL;
|
|
s/^\\\\/\\\\\\/;
|
|
$vblsxslogs = "$_\\build_logs\\binplace*.log-sxs";
|
|
for (glob($vblsxslogs)) {
|
|
$orig = $_;
|
|
s/.*\\(.*)(\.log-sxs)/$1-vbl$2/;
|
|
copy ($orig, "$NTTree\\build_logs\\$_") or die "Can't copy down vbl's WinFuse sxs list [$orig]?";
|
|
$atleastonesxslogexisted = true;
|
|
}
|
|
die "No WinFuse build logs exist on build server, can't continue" unless $atleastonesxslogexisted;
|
|
|
|
|
|
|
|
printall "Copying $ToCopy files from VBL\n";
|
|
|
|
for (keys %VBLFileList) {
|
|
if ($TargFileList{$_}) {
|
|
$NonCopyCount++;
|
|
next;
|
|
}
|
|
|
|
$VBfile = "$VBL\\$_";
|
|
$NTfile = "$NTTree\\$_";
|
|
|
|
#
|
|
# We try to create each directory the first time we see it, just in case.
|
|
#
|
|
$dir = $_;
|
|
$r = $dir =~ s/\\[^\\]+$//;
|
|
if ($r) {
|
|
@dirs = explodedir $dir;
|
|
for (@dirs) {
|
|
$mdname = "$NTTree\\$_";
|
|
next if $seencount{$_}++ or -d $mdname;
|
|
$r = mkdir $mdname, 0777;
|
|
if (not $r) {
|
|
printall $PGM . "ERROR: mkdir $mdname FAILED: $!\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
$CopyCount++;
|
|
if ($Fake) {
|
|
print LOGFILE "Faking: copy $VBfile $NTfile\n";
|
|
} else {
|
|
|
|
#
|
|
# Do copy.
|
|
#
|
|
# populatecopy seems to be faster than copy, but what we should
|
|
# really get is a parallel copy.
|
|
|
|
#
|
|
# copy has been used more than populatecopy because the latter wasn't
|
|
# using O_BINARY when opening the files. populatecopy seems to work fine now,
|
|
# but it is only 9% faster -- so we'll stick with copy.
|
|
#
|
|
|
|
# $r = populatecopy ($VBfile, $NTfile);
|
|
$r = copy ($VBfile, $NTfile);
|
|
|
|
print TSTFILE "Copy<$r>: $VBfile -> $NTfile\n" if $Test;
|
|
|
|
if (not $r) {
|
|
printall "FAILED: copy $VBfile $NTfile: $!\n";
|
|
} else {
|
|
$t = -s $NTfile;
|
|
|
|
$v = -s $VBfile;
|
|
if ($v != $t) {
|
|
printall "SIZE ERROR $_: NTTree=$t VBL=$v\n";
|
|
}
|
|
|
|
$CopyBytes += $t;
|
|
}
|
|
|
|
#
|
|
# Do comparison, if requested.
|
|
#
|
|
if ($Compare) {
|
|
$r = compare ($VBfile, $NTfile);
|
|
if ($r) {
|
|
printall "COMPARSION ERROR <$r>: $VBfile $NTfile: $!\n";
|
|
}
|
|
}
|
|
|
|
#
|
|
# Mark progress (if requested)
|
|
# Estimated completion is pretty bogus
|
|
# The adaptive timing of updates sort of works. At least
|
|
# we aren't checking the time a lot.
|
|
#
|
|
$datarate = 1024*1024;
|
|
if (not $Fake and $Progress) {
|
|
if ($CopyBytes > $lastcopybytes + 5*$datarate # every 5 secs
|
|
or $CopyCount > $lastcopycount + 100) { # or every 100 files
|
|
|
|
$lasttime = $preptime unless $lasttime;
|
|
|
|
$newtime = time();
|
|
|
|
$datarate = ($CopyBytes-$lastcopybytes)/($newtime - $lasttime);
|
|
$esttotalbytes = $CopyBytes * ($ToCopy / $CopyCount);
|
|
|
|
$eta = ($esttotalbytes - $CopyBytes) / $datarate;
|
|
|
|
($h0, $m0, $s0) = hms $eta;
|
|
|
|
$foo = sprintf "Status: %5dMB (%5d of %5d files) copied (%%%5.2f)"
|
|
. " %7.2f KB/S estimated complete in %d:%02d:%02d \r",
|
|
$CopyBytes/1024/1024,
|
|
$CopyCount, $ToCopy,
|
|
100 * $CopyCount / $ToCopy,
|
|
$datarate/1024, $h0, $m0, $s0;
|
|
|
|
print $foo;
|
|
|
|
if ($Test) {
|
|
$foo =~ s/\r/\n/;
|
|
print TSTFILE $foo;
|
|
}
|
|
|
|
$lastcopybytes = $CopyBytes;
|
|
$lastcopycount = $CopyCount;
|
|
$lasttime = $newtime;
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
printf "\n";
|
|
|
|
|
|
$t0 = $preptime - $begintime;
|
|
$t1 = time() - $preptime;
|
|
($h0, $m0, $s0) = hms $t0;
|
|
($h1, $m1, $s1) = hms $t1;
|
|
($h2, $m2, $s2) = hms ($t0 + $t1);
|
|
|
|
if (not $Fake) {
|
|
$KB = $CopyBytes/1024;
|
|
$MB = $KB/1024;
|
|
|
|
$kbrate = $KB/$t1 unless not $t1;
|
|
|
|
printfall "Populated $NTTree with $CopyCount files (%4.0f MB)"
|
|
. " from $VBL [%7.2f KB/S]\n", $MB, $kbrate;
|
|
}
|
|
|
|
|
|
printall "NTTree had $NonCopyCount non-replaced files. VBL total files were $TotalCount.\n";
|
|
|
|
printfall "Preparation time %5d secs (%d:%02d:%02d)\n", $t0, $h0, $m0, $s0;
|
|
printfall "CopyFile time %5d secs (%d:%02d:%02d)\n", $t1, $h1, $m1, $s1;
|
|
printfall "TotalTime time %5d secs (%d:%02d:%02d)\n", $t0+$t1, $h2, $m2, $s2;
|
|
|
|
#
|
|
# Return an error if we were faking so timebuild doesn't proceed.
|
|
#
|
|
close LOGFILE;
|
|
close TSTFILE if $Test;
|
|
exit $Fake;
|
|
|