Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1082 lines
32 KiB

  1. # FileName: PopulateFromVBL.pl
  2. #
  3. # Have any changes to this file reviewed by DavePr, BryanT, or WadeLa
  4. # before checking in.
  5. # Any changes need to verified in all standard build/rebuild scenarios.
  6. #
  7. # Usage = PopulateFromVBL.pl [-force] [-vbl=vblreleasedir] [-nttree=nttreedir] [-symbols]
  8. #
  9. # Function: Populate missing files in nttreedir from vblreleaseddir so
  10. # 0) Verify that binplacedir and VBL are (compatible?) release directories
  11. # 1) Find the binplace.log output for both paths
  12. # 2) Figure out what projects were built in the nttree
  13. # 3) Generate a list of files that were built on VBL for the projectlist
  14. # 4) Output a list of files we should have built locally, but didn't
  15. # 5) If (4) is empty, or -force, populate missing files in nttreedir
  16. # from vblreleaseedir forall projects
  17. #
  18. # No files in nttreedir are overwritten from vblreleasedir
  19. # The checks for what should be there are not exact, because we rely only on
  20. # binplace.log entries -- and the VBL build may not exactly match the nttree build.
  21. #
  22. # [-force] -- do copying even if the nttree doesn't contain project files built in VBL
  23. # [-verbose] -- chatter while working
  24. # [-fake] -- don't do the actual copies
  25. # [-checkbinplace] -- note VBL files that are in binplace.log but not build.binlist
  26. # [-fulltargetok] -- run even if the target machine has built in all projects
  27. #
  28. #
  29. # VBLpath will be computed from BuildMachines.txt if not supplied either
  30. # on the command line, or in the VBL_RELEASE environment variable.
  31. #
  32. # If we are a build lab, we succeed without doing much.
  33. #
  34. # WARNING:
  35. # WARNING: make sure pathname comparisons are case insensitive. Either convert the case or do the
  36. # WARNING: comparisons like this:
  37. # WARNING: if ($foo =~ /^\Q$bar\E$/i) {}
  38. # WARNING: or if ($foo !~ /^\Q$bar\E$/i) {}
  39. # WARNING:
  40. #
  41. # BUGBUG: Still need to copy down the compressed directory, per Wade's request...
  42. # ... but I'm really hoping that this will translate into an opportunity not
  43. # ... to copy down the uncompressed version from the VBL... Or, as MarkL suggested,
  44. # ... I should uncompress the compressed version rather than copy it. I'd need to
  45. # ... validate this, maybe in postbuild on the VBL?
  46. $begintime = time();
  47. $VBLPathVariableName = 'VBL_RELEASE';
  48. $BuildMachinesFile = $ENV{ "RazzleToolPath" } . "\\BuildMachines.txt";
  49. $SdDotMapPathname = "sd.map";
  50. $LogFile = "build.populate";
  51. $BinListFile = "build.binlist";
  52. $TestFileName = "build.testpopulate";
  53. $CDDATAFileName = "cddata.txt";
  54. #
  55. # Build the complete list of non-root projects
  56. #
  57. @Projects = (public, mergedcomponents, tools,
  58. admin, base, com, drivers, ds, enduser, inetcore, inetsrv,
  59. multimedia, net, printscan, sdktools, shell, termsrv, windows);
  60. for (@Projects) {
  61. $Project{$_} = 1;
  62. }
  63. #
  64. # Projects that aren't really projects, but might be found in the binplace log and should just be ignored.
  65. #
  66. @PseudoProjects = ("pre-bbt");
  67. for (@PseudoProjects) {
  68. $PseudoProject{$_} = 1;
  69. }
  70. #
  71. # MagicPrefixes are places where VBLs (or notably main) build things not under SDXROOT
  72. #
  73. @MagicRoots = (bbt_return);
  74. for (@MagicRoots) {
  75. $MagicRoot{$_} = 1;
  76. }
  77. #
  78. # Usage variables
  79. #
  80. $PGM='PopulateFromVBL: ';
  81. $Usage = $PGM . "Usage: PopulateFromVBL.pl [-force] [-vbl=vblreleasedir] [-nttree=nttreedir] [-symbols]\n";
  82. #
  83. # Get the current directory
  84. #
  85. open CWD, 'cd 2>&1|';
  86. $CurrDir = <CWD>;
  87. close CWD;
  88. chomp $CurrDir;
  89. $CurrDrive = substr($CurrDir, 0, 2);
  90. #
  91. # Check variables expected to be set in the environment.
  92. #
  93. $sdxroot = $ENV{'SDXROOT'} or die $PGM, "Error: SDXROOT not set in environment\n";
  94. $buildarch = $ENV{'_BuildArch'} or die $PGM, "Error: _BuildArch not set in environment\n";
  95. $computername = $ENV{'COMPUTERNAME'} or die $PGM, "Error: COMPUTERNAME not set in environment\n";
  96. $branchname = $ENV{'_BuildBranch'} or die $PGM, "Error: _BuildBranch not set in environment\n";
  97. $foo = $ENV{'NTDEBUG'} or die $PGM, "Error: NTDEBUG not set in environment\n";
  98. $dbgtype = 'chk';
  99. $dbgtype = 'fre' if $foo =~ /nodbg$/i;
  100. #
  101. # initialize argument variables
  102. #
  103. $Fake = $ENV{'POPULATEFROMVBL_FAKE'};
  104. $Verbose = $ENV{'POPULATEFROMVBL_VERBOSE'};
  105. $Compare = $ENV{'POPULATEFROMVBL_COMPARE'};
  106. $Progress = $ENV{'POPULATEFROMVBL_PROGRESS'};
  107. $Test = $ENV{'POPULATEFROMVBL_TEST'};
  108. $Symbols = $ENV{'POPULATEFROMVBL_SYMBOLS'};
  109. $SkipPats = $ENV{'POPULATEFROMVBL_SKIP'};
  110. $CDDataOnly = $ENV{'POPULATEFROMVBL_CDDATAONLY'};
  111. $Force = 0;
  112. $FullTargetOk = 0;
  113. $CheckBinplace = 0;
  114. #
  115. # Debug routines for printing out variables
  116. #
  117. sub gvar {
  118. for (@_) {
  119. print "\$$_ = $$_\n";
  120. }
  121. }
  122. #
  123. # print on the various files
  124. #
  125. sub printall {
  126. print TSTFILE @_ if $Test;
  127. print LOGFILE @_;
  128. print $PGM unless @_ == 1 and @_[0] eq "\n";
  129. print @_;
  130. }
  131. sub printfall {
  132. printf TSTFILE @_ if $Test;
  133. printf LOGFILE @_;
  134. print $PGM unless @_ == 1 and @_[0] eq "\n";
  135. printf @_;
  136. }
  137. #
  138. # Sub hms
  139. # Takes Argument time in seconds and returns as list of (hrs, mins, secs)
  140. #
  141. sub hms {
  142. $s = shift @_;
  143. $h = int ($s / 3600);
  144. $s -= 3600*$h;
  145. $m = int ($s / 60);
  146. $s -= 60*$m;
  147. return ($h, $m, $s);
  148. }
  149. #
  150. # signal catcher (at least this would work on unix)
  151. #
  152. sub catch_ctrlc {
  153. printall "Aborted.\n";
  154. die $PGM, "Error: Aborted.\n";
  155. }
  156. $SIG{INT} = \&catch_ctrlc;
  157. #
  158. # routine to fully qualify a pathname
  159. #
  160. sub fullyqualify {
  161. die $PGM . "Error: Internal error in fullpathname().\n" unless @_ == 1;
  162. $_ = @_[0];
  163. if (/\s/) { die $PGM, "Error: Spaces in pathnames not allowed: '", $_, "'\n"; }
  164. return $_ unless $_; # empty strings are a noop
  165. s/([^:])\\$/$1/; # get rid of trailing \
  166. while (s/\\\.\\/\\/) {} # get rid of \.\
  167. while (s/\\[^\\]+\\\.\.\\/\\/) {} # get rid of \foo\..\
  168. s/\\[^\\]+\\\.\.$/\\/; # get rid of \foo\..
  169. s/:[^\\]+\\\.\.$/:/; # get rid of x:foo\..
  170. s/([^:])\\\.$/$1/; # get rid of foo\.
  171. s/:\\\.$/:\\/; # get rid of x:\.
  172. s/:[^\\]+\\\.\.$/:/; # get rid of x:foo\..
  173. s/^$CurrDrive[^\\]/$CurrDir\\/i; # convert drive-relative on current drive
  174. if (/^[a-z]:\\/i) { return $_; } # full
  175. if (/^\\[^\\].*/) { return "$CurrDrive$_"; } # rooted
  176. if (/^\\\\[^\\]/) {
  177. # print $PGM, 'Warning: Use of UNC name bypasses safety checks: ', $_, "\n";
  178. return $_; # UNC
  179. }
  180. if (/^\.$/) { return "$CurrDir"; } # dot
  181. if (/^$CurrDrive\.$/i) { return "$CurrDir"; } # dot on current drive
  182. if (/^[^\\][^:].*/i) { return "$CurrDir\\$_"; } # relative
  183. if (/^([a-z]:)([^\\].*)/i) { $drp = $CurrDir; # this case handled above
  184. if ($1 ne $CurrDir) {
  185. # $drp = $ENV{"=$1"}; # doesn't work!
  186. die $PGM, "Error: Can't translate drive-relative pathnames: ", $_, "\n";
  187. }
  188. return "$drp\\$2"; # drive:relative
  189. }
  190. die $PGM, "Error: Unrecognized pathname format: $_\n";
  191. }
  192. #
  193. # Routine for exploding directory names into a list of components (for mkdir)
  194. #
  195. sub explodedir {
  196. my(@explodelist) = ();
  197. my(@components);
  198. my($path);
  199. for (@_) {
  200. $_ = shift;
  201. @components = split /\\/;
  202. push @components, "";
  203. $path = shift @components;
  204. for (@components) {
  205. push @explodelist, $path;
  206. $path = $path . "\\" . $_;
  207. }
  208. }
  209. return @explodelist;
  210. }
  211. #
  212. # Routine to copy a file -- avoiding win32::CopyFile
  213. #
  214. # BUGBUG: This doesn't work. sysread() seems broken.
  215. #
  216. #
  217. use Fcntl;
  218. sub populatecopy {
  219. my $writesize = 64*4096;
  220. my($src, $dst) = @_;
  221. my($infile, $outfile, $buf, $n, $r, $o);
  222. if (not sysopen INFILE, $src, O_RDONLY() | O_BINARY()) {
  223. return 0;
  224. }
  225. if (not sysopen OUTFILE, $dst, O_WRONLY() | O_CREAT() | O_TRUNC() | O_BINARY(), 0666) {
  226. close INFILE;
  227. return 0;
  228. }
  229. $r = 0; # need this to be defined in case INFILE is empty
  230. ERR: while ($n = sysread INFILE, $buf, $writesize) {
  231. last ERR unless defined $n;
  232. $o = 0;
  233. while ($n) {
  234. $r = syswrite OUTFILE, $buf, $n, $o;
  235. last ERR unless defined $r;
  236. $n -= $r;
  237. $o += $r;
  238. }
  239. }
  240. close INFILE;
  241. close OUTFILE;
  242. return 0 if not defined $n or not defined $r or $n != 0;
  243. return 1;
  244. }
  245. use File::Copy;
  246. use File::Compare;
  247. #
  248. # Process and validate arguments
  249. #
  250. for (@ARGV) {
  251. if (/^[\/\-]test$/i) { $Test++; next; }
  252. if (/^[\/\-]verbose$/i) { $Verbose++; next; }
  253. if (/^[\/\-]cddataonly$/i) { $CDDataOnly++; next; }
  254. if (/^[\/\-]compare$/i) { $Compare++; next; }
  255. if (/^[\/\-]symbols$/i) { $Symbols++; next; }
  256. if (/^[\/\-]force$/i) { $Force++; next; }
  257. if (/^[\/\-]fake$/i) { $Fake++; next; }
  258. if (/^[\/\-]fulltargetok$/i) { $FullTargetOk++; next; }
  259. if (/^[\/\-]vbl=(.+)$/i) { $VBL = $1; next; }
  260. if (/^[\/\-]nttree=(.+)$/i) { $NTTree = $1; next; }
  261. if (/^[\/\-]skip=(.+)$/i) { $SkipPats .= "$1;"; next; }
  262. if (/^[\/\-]?$/i) { die $Usage; }
  263. if (/^[\/\-]help$/i) { die $Usage; }
  264. if (/^[\/\-]checkbinplace$/i) { $CheckBinplace++; next; }
  265. die $Usage;
  266. }
  267. #
  268. # If we didn't get the NTTree directory from the command line,
  269. # get it from the _NTTREE environment variable.
  270. #
  271. $NTTree = $ENV{'_NTTREE'} unless $NTTree;
  272. #
  273. # Can only populate with the current directory the same as sdxroot.
  274. #
  275. die $PGM, "Error: Can only populate if CD <$CurrDir> is SDXROOT <$sdxroot>\n" unless $sdxroot =~ /^\Q$CurrDir\E$/io;
  276. $rc = system "perl $sdxroot\\tools\\CombineDistributedBinplaceLogs.pl -nttree=$NTTree";
  277. die $PGM, "Error: CombineDistributedBinplaceLogs.pl failed.\n" if $rc;
  278. #
  279. # We always need to build a current binlist file -- unless it already exists.
  280. #
  281. $foo = "Creating binlist file with dir command.\n";
  282. print $PGM, $foo;
  283. $NTTreeBinListFile = "$NTTree\\build_logs\\$BinListFile";
  284. if (! -s $NTTreeBinListFile) {
  285. $rc = system "dir /b/s /a-d %_NTTREE% > $NTTreeBinListFile";
  286. die $PGM, "Error: Error building $NTTreeBinListFile: $!\n" if $rc;
  287. }
  288. #
  289. # If we didn't get the local target directory from the command line,
  290. # get it from the environment. If that fails, we parse BuildMachines.txt.
  291. #
  292. # Since BuildMachines.txt doesn't define the VBL directory for IDX builds
  293. # correctly (it points to latest.tst), let's define the VBL share for IDX builds
  294. # based on $(sdxroot)\__bldnum__.
  295. #
  296. $VBL = $ENV{$VBLPathVariableName} unless $VBL;
  297. #
  298. #if IDX build
  299. if ((not $VBL) && ($branchname =~ /^idx[0][1-3]$/i)) {
  300. print $PGM, "Working with IDX branch --- $branchname\n";
  301. $BldNumFile = "$sdxroot\\__bldnum__";
  302. open BLDFILE, "$BldNumFile" or die print $PGM, "Error: Could not open BldNumFile: $BldNumFile\n";
  303. for (<BLDFILE>) {
  304. s/\s+//g;
  305. ($text, $bld) = split /=/;
  306. }
  307. print $PGM, "IDX build ($branchname branch) corresponds to $bld build\n";
  308. $VBL="\\\\ntdev\\release\\main\\usa\\$bld\\$buildarch$dbgtype\\bin";
  309. print $PGM, "VBL = $VBL\n";
  310. close BLDFILE;
  311. }
  312. if ((not $VBL) || ($VBL =~ /^[\d\w_]+$/)) {
  313. $tbranchname = $branchname;
  314. $tbranchname = $VBL if $VBL =~ /^[\d\w_]+$/;
  315. $fname = $BuildMachinesFile;
  316. open BMFILE, $fname or die $PGM, "Error: Could not open: $fname\n";
  317. for (<BMFILE>) {
  318. s/\s+//g;
  319. s/;.*$//;
  320. next if /^$/;
  321. ($vblmach, $vblprime, $vblbranch, $vblarch, $vbldbgtype, $vbldl, $disttype, $alt_release ) = split /,/;
  322. #
  323. #BUGBUG:
  324. # Should this really come through the environment
  325. # variable that declares this to be a VBL?
  326. #
  327. if ($vblmach =~ /\Q$computername\E/io) {
  328. print $PGM, "Skipping populate because this is a VBL machine.\n";
  329. exit 0;
  330. }
  331. if ($vblarch =~ /\Q$buildarch\E/io and $vbldbgtype =~ /\Q$dbgtype\E/io
  332. and $vblbranch =~ /\Q$tbranchname\E/io
  333. and $disttype !~ /distbuild/i) {
  334. if ( defined $alt_release) {
  335. $VBL = $alt_release;
  336. last;
  337. }
  338. else {
  339. $dname = "\\\\$vblmach\\release";
  340. }
  341. opendir BDIR, "$dname\\" or die $PGM, "Error: Could not open directory: $dname\n";
  342. @reldirs = readdir BDIR;
  343. close BDIR;
  344. $rname = 0;
  345. $date = 0;
  346. for (@reldirs) {
  347. next unless /[0-9]+\.$vblarch$vbldbgtype\.$vblbranch\.(.+)$/io;
  348. ($date = $1, $rname = $_) unless $date gt $1
  349. or substr($date, 0, 2) eq '00' and substr($1, 0, 2) eq '99'; # Y2K trade-off
  350. }
  351. if (not $rname) {
  352. print $PGM, "Warning: No valid release shares found on $dname.\n";
  353. } else {
  354. $VBL = "$dname\\$rname";
  355. }
  356. last;
  357. }
  358. }
  359. close BMFILE;
  360. }
  361. die $PGM, "Error: Not a directory: ", $VBL, "\n" if $VBL and ! -d $VBL;
  362. die $Usage unless $NTTree;
  363. die $PGM, "Error: Not a directory: ", $NTTree, "\n" unless -d $NTTree;
  364. die $PGM, "Error: Not writable: ", $NTTree, "\n" unless -w $NTTree;
  365. $SkipPats =~ tr/@/^/;
  366. $SkipPats =~ s/;;+/;/g;
  367. $SkipPats =~ s/\\/\\\\/g;
  368. $SkipPats =~ s/\\\\\./\\./g;
  369. $SkipPats =~ s/^;//;
  370. $SkipPats =~ s/;$//;
  371. @SkipPatterns = split /;/, $SkipPats if $SkipPats;
  372. #
  373. # Fully qualify the pathnames
  374. #
  375. $VBL = fullyqualify($VBL) if $VBL;
  376. $NTTree = fullyqualify($NTTree);
  377. #
  378. # Open the logfile, and maybe the testfile
  379. #
  380. $foo = "$NTTree\\build_logs\\$LogFile";
  381. open LOGFILE, ">>$foo" or die $PGM, "Error: Could not create logfile: ", $foo, ": $!\n";
  382. open TSTFILE, ">$TestFileName" or die $PGM, "Error: Could not create testfile: ", $TestFileName, ": $!\n" if $Test;
  383. #
  384. # Verify that VBL and NTTree are compatible release directories
  385. # BUGBUG:
  386. # For now, this just means ensure they both have build_logs directories.
  387. # It might be nice to check that the builds are from the same branch, and the same main branch build, but ...
  388. #
  389. die $PGM . "Error: The nttree build_logs not found.\n" unless -d "$NTTree\\build_logs\\.";
  390. if ($VBL) {
  391. die $PGM . "Error: The VBL build_logs not found.\n" unless -d "$VBL\\build_logs\\.";
  392. printall "Populating $NTTree from VBL $VBL\n";
  393. }
  394. #
  395. # Process the CDDATA file to build a real copylist.
  396. #
  397. # BUGBUG: I put the code in to do this (if the flag is set), but
  398. # I don't understand how Wade and Mike thought I could use
  399. # this data to automatically trim what gets copied from the VBL.
  400. #
  401. if ($VBL) {
  402. $CDDATAFileName = "$VBL\\build_logs\\$CDDATAFileName";
  403. printall $PGM . "Warning: Could not open $CDDATAFileName: $!\n" unless -r $CDDATAFileName;
  404. @CDData = ();
  405. if ($CDDataOnly) {
  406. open CDDATA, $CDDATAFileName or die $PGM, "Error: Could not open: ", $CDDATAFileName, ": $!\n";
  407. for (<CDDATA>) {
  408. chomp;
  409. s/\s+//g;
  410. s/;.*//;
  411. next if /^$/;
  412. ($name, $signed, $prodlist, $iscompressed, $isdriver, $isprinter, $dosnet)
  413. = /(.*)=([tf]):([a-z]+):([tf]):([tf]):([tf]):([tf])/;
  414. printall $PGM . "WARNING: failed to parse cddata line: $_\n" unless $name;
  415. next unless $name;
  416. $CDData{$name}++;
  417. }
  418. close CDDATA;
  419. }
  420. }
  421. #
  422. # Alert that we are skipping certain classes of files
  423. #
  424. printall "Skipping various symbols directories.\n" unless $Symbols;
  425. printall "Skipping delayload directory.\n";
  426. printall "Skip Patterns:\n";
  427. for (@SkipPatterns) {
  428. $pat = $_;
  429. $pat =~ s/\\\\/\\/g;
  430. printall "Skip /$pat/\n";
  431. }
  432. #
  433. # BUGBUG:
  434. # At some point, there will be a file in build_logs which we tell use
  435. # interesting details about a build. We will want to dump out the contents
  436. # of this file for both VBL and NTTree, so the user can see what they
  437. # are getting themselves into.
  438. #
  439. #
  440. # Read in the VBL and NTTree binplace logs and process them
  441. #
  442. open BINPLACE, "$NTTree\\build_logs\\binplace.log"
  443. #or open BINPLACE, "$NTTree\\binplace.log"
  444. or die $PGM, "Error: Could not open: ", "$NTTree\\build_logs\\binplace.log", "\n";
  445. $nignored = 0;
  446. for (<BINPLACE>) {
  447. $whichline++;
  448. tr/A-Z/a-z/;
  449. $skipline = 0;
  450. # First test skips case where NTTree is under SDXROOT and there are binplace records (thanks to SCP)
  451. if (/^\Q$NTTree\E\\/io) {
  452. $skipline = 1;
  453. } elsif (/^\Q$sdxroot\E\\([^\\]+)\\([^\s]+)\\([^\\\s]*)\s+\t/io) {
  454. $project=$1; $relpath=$2; $filename=$3;
  455. } else {
  456. $skipline = 1;
  457. }
  458. if ($skipline) {
  459. print TSTFILE "Ignored TARG binplace record at line $whichline: ", $_ if $Test;
  460. $nignored++;
  461. if ($Verbose && $nignored <= 10) {
  462. print LOGFILE $PGM . "Ignored TARG binplace record at line $whichline: ", $_;
  463. print LOGFILE $PGM . "...\n" if $nignored == 10;
  464. }
  465. next;
  466. }
  467. $project =~ tr/A-Z/a-z/;
  468. $relpath =~ tr/A-Z/a-z/;
  469. $filename =~ tr/A-Z/a-z/;
  470. if (not $Project{$project} and not $PseudoProject{$project}) {
  471. $msg = $PGM . "Error: NTTREE: unknown project '$project' at line $whichline: $_\n";
  472. if ($Fake) { warn $msg; } else { die $msg; }
  473. next;
  474. }
  475. $TargCounts{$project}++;
  476. push @{"T_" . $project . "_binplaced"}, "$relpath\\$filename";
  477. }
  478. close BINPLACE;
  479. if ($Verbose) {
  480. $total = 0;
  481. printall "\n";
  482. printall "NTTree project counts\n";
  483. for (@Projects) {
  484. printfall " %5d %s\n", $TargCounts{$_}, $_;
  485. $total += $TargCounts{$_};
  486. }
  487. printall "-----------------\n";
  488. printfall " %5d TOTAL\n", $total;
  489. printfall " %5d records ignored\n\n", $nignored if $nignored;
  490. }
  491. #
  492. # If files have been binplaced in all the projects, we assume all projects are built locally, and
  493. # don't try to populate -- unless explictly told to do so by the -fulltargetbuildok
  494. #
  495. if (not $FullTargetOk) {
  496. $TargetIsFullBuild = 1;
  497. for (@Projects) {
  498. next if /public/;
  499. next if $TargCounts{$_};
  500. $TargetIsFullBuild = 0;
  501. }
  502. if ($TargetIsFullBuild) {
  503. printall "Not run because $NTTree should be a full build of all projects.\n";
  504. close LOGFILE;
  505. close TSTFILE if $Test;
  506. exit 0;
  507. }
  508. }
  509. die $PGM, "Error: There was trouble finding a VBL.\n" unless $VBL;
  510. open BINPLACE, "$VBL\\build_logs\\binplace.log"
  511. #or open BINPLACE, "$VBL\\binplace.log"
  512. or die $PGM, "Error: Could not open: ", "$VBL\\build_logs\\binplace.log", "\n";
  513. $nignored = 0;
  514. $whichline = 0;
  515. for (<BINPLACE>) {
  516. $whichline++;
  517. tr/A-Z/a-z/;
  518. #
  519. # BUGBUG: assumes all VBLs build under an sdxroot something like x:\foo
  520. #
  521. if (/^[a-z]:\\([^\\]+)\\([^\\]+)\\([^\s]+)\\([^\\\s]*)\s+\t/io) { $rootname=$1; $project=$2; $relpath=$3; $filename=$4; }
  522. else {
  523. print TSTFILE "Ignored VBL binplace record at line $whichline: ", $_ if $Test;
  524. $nignored++;
  525. if ($Verbose && $nignored <= 10) {
  526. print LOGFILE $PGM, "Ignored VBL binplace record at line $whichline: ", $_;
  527. print LOGFILE $PGM, "...\n" if $nignored == 10;
  528. }
  529. next;
  530. }
  531. $project =~ tr/A-Z/a-z/;
  532. $relpath =~ tr/A-Z/a-z/;
  533. $filename =~ tr/A-Z/a-z/;
  534. die $PGM . "Error: VBL: unknown project at line $whichline: " . $_ . "\n" unless $MagicRoot{$rootname} or $Project{$project} or $PseudoProject{$project};
  535. $VBLCounts{$project}++;
  536. push @{"V_" . $project . "_binplaced"}, "$relpath\\$filename";
  537. }
  538. close BINPLACE;
  539. #
  540. # Check that VBL built stuff everywhere, except maybe 'public'.
  541. #
  542. for (@Projects) {
  543. next if /public/;
  544. if (not $VBLCounts{$project}) {
  545. printall "VBL did not build anything in ", $_, "\n";
  546. $fatal++;
  547. }
  548. }
  549. if ($Verbose or $fatal) {
  550. $total = 0;
  551. printall "\n";
  552. printall "VBL project counts\n";
  553. for (@Projects) {
  554. printfall " %5d %s\n", $VBLCounts{$_}, $_;
  555. $total += $VBLCounts{$_};
  556. }
  557. printall "-----------------\n";
  558. printfall " %5d TOTAL\n", $total;
  559. printfall " %5d records ignored\n\n", $nignored if $nignored;
  560. }
  561. die $PGM, "Error: VBL release seems bad.\n" if $fatal;
  562. #
  563. # Analyze what got built on the VBL versus the local tree
  564. #
  565. # For each project that we built locally, see if there are any files
  566. # in the VBL tree that we are missing.
  567. #
  568. $NotLocallyPlaced = 0;
  569. %VBLhash = ();
  570. %Targhash = ();
  571. for (@Projects) {
  572. next if /public/ or not $TargCounts{$_};
  573. $project = $_;
  574. #
  575. # Build a hash table for the VBL files, and check target files.
  576. # and vice-versa...
  577. #
  578. for (@{"V_" . $project . "_binplaced"}) {
  579. $VBLhash{$_} = 1;
  580. }
  581. for (@{"T_" . $project . "_binplaced"}) {
  582. printall 'Warning: non-VBL file binplaced on target: ', $_, "\n" unless $VBLhash{$_};
  583. $Targhash{$_} = 1;
  584. }
  585. for (@{"V_" . $project . "_binplaced"}) {
  586. next if $Targhash{$_};
  587. printall 'WARNING: VBL file not binplaced on target: ', $_, "\n";
  588. $NotLocallyPlaced++;
  589. }
  590. }
  591. if ($NotLocallyPlaced and not $Force) {
  592. die $PGM, "Error: ", $NotLocallyPlaced, " binplaced VBL files were not binplaced into ", $NTTree, "\n";
  593. }
  594. #
  595. # Thats the checks. Now we just have to do the actual populate.
  596. #
  597. #
  598. # Do a directory listing
  599. # Build build.binlist for NTTREE
  600. # Read in the build.binlist files for NTTree.
  601. # Read in the build.binlist files for the VBL.
  602. #
  603. open BINLIST, "$NTTreeBinListFile"
  604. or die $PGM, "Error: Could not open: ", "$NTTreeBinListFile", "\n";
  605. $whichline = 0;
  606. for (<BINLIST>) {
  607. #
  608. #
  609. $whichline++;
  610. tr/A-Z/a-z/;
  611. chomp;
  612. if (/^\Q$NTTree\E\\([^\s]*)$/io) {
  613. $relpath = $1;
  614. #
  615. # ignore symbol and other directories
  616. #
  617. if (not $Symbols) {
  618. next if /\\symbolcd\\/i;
  619. next if /\\symbols\.pri\\/i;
  620. next if /\\symbols\\/i;
  621. next if /\\scp_wpa\\/i;
  622. # instead we use $SkipPatterns
  623. # next if $relpath =~ /^mstools\\/i;
  624. # next if $relpath =~ /^idw\\/i;
  625. # next if $relpath =~ /^dump\\/i;
  626. # next if $relpath =~ /^clients\\/i;
  627. }
  628. #
  629. # ignore delayload directory
  630. #
  631. next if /\\delayload\\/i;
  632. #
  633. # ignore HelpAndSupportServices directory
  634. #
  635. next if /\\HelpAndSupportServices\\/i;
  636. #
  637. # ignore paths that match skip patterns
  638. #
  639. $skiphit = 0;
  640. for (@SkipPatterns) {
  641. $skiphit = $relpath =~ /$_/i;
  642. $spat = $_;
  643. last if $skiphit;
  644. }
  645. print TSTFILE "TARG: skipping $relpath\n" if $Test and $skiphit;
  646. next if $skiphit;
  647. $TargFileList{$relpath} = 1;
  648. } else {
  649. $fatal++;
  650. printall "Could not parse target build.binplace at line ", $whichline, ": ", $_, "\n";
  651. }
  652. }
  653. close BINLIST;
  654. #
  655. # BUGBUG... in a few releases these will all be in build_logs
  656. #
  657. $foo = "$VBL\\build_logs\\$BinListFile";
  658. open BINLIST, $foo
  659. or open BINLIST, "$VBL\\$BinListFile"
  660. or die $PGM, "Error: Could not open: ", $foo, "\n";
  661. $whichline = 0;
  662. for (<BINLIST>) {
  663. $whichline++;
  664. tr/A-Z/a-z/;
  665. chomp;
  666. if (/^[a-z]:\\[^\\]+\\([^\s]*)$/io) {
  667. $relpath = $1;
  668. #
  669. # skip log files found in VBL.
  670. #
  671. next if /\\build\.[^\\]+$/i;
  672. next if /\\build_logs\\/i;
  673. #
  674. # ignore symbol directories
  675. #
  676. if (not $Symbols) {
  677. next if /\\symbolcd\\/i;
  678. next if /\\symbols\.pri\\/i;
  679. next if /\\symbols\\/i;
  680. # instead we use $SkipPatterns
  681. # next if $relpath =~ /^mstools\\/i;
  682. # next if $relpath =~ /^idw\\/i;
  683. # next if $relpath =~ /^dump\\/i;
  684. # next if $relpath =~ /^clients\\/i;
  685. }
  686. #
  687. # ignore delayload directory
  688. #
  689. next if /\\delayload\\/i;
  690. #
  691. # ignore HelpAndSupportServices directory
  692. #
  693. next if /\\HelpAndSupportServices\\/i;
  694. #
  695. # ignore paths that match skip patterns
  696. #
  697. $skiphit = 0;
  698. for (@SkipPatterns) {
  699. $skiphit = $relpath =~ /$_/i;
  700. $spat = $_;
  701. last if $skiphit;
  702. }
  703. print TSTFILE "VBL: skipping $relpath\n" if $Test and $skiphit;
  704. next if $skiphit;
  705. $VBLFileList{$relpath} = 1;
  706. } else {
  707. $fatal++;
  708. printall "Could not parse VBL build.binplace at line ", $whichline, ": ", $_, "\n";
  709. }
  710. }
  711. close BINLIST;
  712. die $PGM, "Error: Fatal error parsing build.binplace.\n" if $fatal;
  713. #
  714. # Optionally note VBL files that were not binplaced.
  715. #
  716. if ($CheckBinplace) {
  717. printall "Checking non-binplaced VBL files\n";
  718. for (@VBLFileList) {
  719. next unless $VBLhash{$_};
  720. printall "Info: Non-binplaced VBL file: ", $_, "\n";
  721. }
  722. }
  723. if ($Test) {
  724. print TSTFILE "#VBLhash=", scalar keys %VBLhash, " #Targhash=", scalar keys %Targhash, "\n";
  725. print TSTFILE "#VBLFileList=", scalar keys %VBLFileList, " #TargFileList=", scalar keys %TargFileList, "\n";
  726. }
  727. #
  728. # Generate list of files to copy (i.e. every file in VBLFileList not in TargFileList).
  729. #
  730. printall "FAKING -- NO COPYING ACTUALLY BEING DONE\n" if $Fake;
  731. $preptime = time();
  732. $TotalCount = scalar keys %VBLFileList;
  733. $ToCopy = $TotalCount - keys %TargFileList;
  734. if ($TotalCount < 1000 or $ToCopy < 0) {
  735. printall "ERROR: Something wrong with VBL build.binlist -- only $TotalCount files.\n";
  736. exit 1;
  737. }
  738. $CopyCount = 0;
  739. $NonCopyCount = 0;
  740. $CopyBytes = 0;
  741. # 12/28/2000 - added by jonwis
  742. #
  743. # Special code for SxS goop:
  744. # - Copies down the vbl's binplace logs to $NTTree\\build_logs\\$(binplace file name root)-vbl.log-sxs
  745. # This ensures that the sxs wfp updating code will actually pick up the vbl's binplaced assemblies
  746. # as well as assemblies that the user has created.
  747. # Add an extra backslash if the $VBL macro starts with \\. Otherwise, glob won't find the files.
  748. $_=$VBL;
  749. s/^\\\\/\\\\\\/;
  750. $vblsxslogs = "$_\\build_logs\\binplace*.log-sxs";
  751. for (glob($vblsxslogs)) {
  752. $orig = $_;
  753. s/.*\\(.*)(\.log-sxs)/$1-vbl$2/;
  754. copy ($orig, "$NTTree\\build_logs\\$_") or die "Can't copy down vbl's WinFuse sxs list [$orig]?";
  755. $atleastonesxslogexisted = true;
  756. }
  757. die "No WinFuse build logs exist on build server, can't continue" unless $atleastonesxslogexisted;
  758. printall "Copying $ToCopy files from VBL\n";
  759. for (keys %VBLFileList) {
  760. if ($TargFileList{$_}) {
  761. $NonCopyCount++;
  762. next;
  763. }
  764. $VBfile = "$VBL\\$_";
  765. $NTfile = "$NTTree\\$_";
  766. #
  767. # We try to create each directory the first time we see it, just in case.
  768. #
  769. $dir = $_;
  770. $r = $dir =~ s/\\[^\\]+$//;
  771. if ($r) {
  772. @dirs = explodedir $dir;
  773. for (@dirs) {
  774. $mdname = "$NTTree\\$_";
  775. next if $seencount{$_}++ or -d $mdname;
  776. $r = mkdir $mdname, 0777;
  777. if (not $r) {
  778. printall $PGM . "ERROR: mkdir $mdname FAILED: $!\n";
  779. }
  780. }
  781. }
  782. $CopyCount++;
  783. if ($Fake) {
  784. print LOGFILE "Faking: copy $VBfile $NTfile\n";
  785. } else {
  786. #
  787. # Do copy.
  788. #
  789. # populatecopy seems to be faster than copy, but what we should
  790. # really get is a parallel copy.
  791. #
  792. # copy has been used more than populatecopy because the latter wasn't
  793. # using O_BINARY when opening the files. populatecopy seems to work fine now,
  794. # but it is only 9% faster -- so we'll stick with copy.
  795. #
  796. # $r = populatecopy ($VBfile, $NTfile);
  797. $r = copy ($VBfile, $NTfile);
  798. print TSTFILE "Copy<$r>: $VBfile -> $NTfile\n" if $Test;
  799. if (not $r) {
  800. printall "FAILED: copy $VBfile $NTfile: $!\n";
  801. } else {
  802. $t = -s $NTfile;
  803. $v = -s $VBfile;
  804. if ($v != $t) {
  805. printall "SIZE ERROR $_: NTTree=$t VBL=$v\n";
  806. }
  807. $CopyBytes += $t;
  808. }
  809. #
  810. # Do comparison, if requested.
  811. #
  812. if ($Compare) {
  813. $r = compare ($VBfile, $NTfile);
  814. if ($r) {
  815. printall "COMPARSION ERROR <$r>: $VBfile $NTfile: $!\n";
  816. }
  817. }
  818. #
  819. # Mark progress (if requested)
  820. # Estimated completion is pretty bogus
  821. # The adaptive timing of updates sort of works. At least
  822. # we aren't checking the time a lot.
  823. #
  824. $datarate = 1024*1024;
  825. if (not $Fake and $Progress) {
  826. if ($CopyBytes > $lastcopybytes + 5*$datarate # every 5 secs
  827. or $CopyCount > $lastcopycount + 100) { # or every 100 files
  828. $lasttime = $preptime unless $lasttime;
  829. $newtime = time();
  830. $datarate = ($CopyBytes-$lastcopybytes)/($newtime - $lasttime);
  831. $esttotalbytes = $CopyBytes * ($ToCopy / $CopyCount);
  832. $eta = ($esttotalbytes - $CopyBytes) / $datarate;
  833. ($h0, $m0, $s0) = hms $eta;
  834. $foo = sprintf "Status: %5dMB (%5d of %5d files) copied (%%%5.2f)"
  835. . " %7.2f KB/S estimated complete in %d:%02d:%02d \r",
  836. $CopyBytes/1024/1024,
  837. $CopyCount, $ToCopy,
  838. 100 * $CopyCount / $ToCopy,
  839. $datarate/1024, $h0, $m0, $s0;
  840. print $foo;
  841. if ($Test) {
  842. $foo =~ s/\r/\n/;
  843. print TSTFILE $foo;
  844. }
  845. $lastcopybytes = $CopyBytes;
  846. $lastcopycount = $CopyCount;
  847. $lasttime = $newtime;
  848. }
  849. }
  850. }
  851. }
  852. printf "\n";
  853. $t0 = $preptime - $begintime;
  854. $t1 = time() - $preptime;
  855. ($h0, $m0, $s0) = hms $t0;
  856. ($h1, $m1, $s1) = hms $t1;
  857. ($h2, $m2, $s2) = hms ($t0 + $t1);
  858. if (not $Fake) {
  859. $KB = $CopyBytes/1024;
  860. $MB = $KB/1024;
  861. $kbrate = $KB/$t1 unless not $t1;
  862. printfall "Populated $NTTree with $CopyCount files (%4.0f MB)"
  863. . " from $VBL [%7.2f KB/S]\n", $MB, $kbrate;
  864. }
  865. printall "NTTree had $NonCopyCount non-replaced files. VBL total files were $TotalCount.\n";
  866. printfall "Preparation time %5d secs (%d:%02d:%02d)\n", $t0, $h0, $m0, $s0;
  867. printfall "CopyFile time %5d secs (%d:%02d:%02d)\n", $t1, $h1, $m1, $s1;
  868. printfall "TotalTime time %5d secs (%d:%02d:%02d)\n", $t0+$t1, $h2, $m2, $s2;
  869. #
  870. # Return an error if we were faking so timebuild doesn't proceed.
  871. #
  872. close LOGFILE;
  873. close TSTFILE if $Test;
  874. exit $Fake;