tools/build_bootleg_win32.pl

   1 #! /usr/bin/perl
   2 # ======================================================================
   3 # ======================================================================
   4
   5 use warnings;
   6 use strict;
   7 use Socket;
   8
   9 # ======================================================================
  10 # Constants
  11 # ======================================================================
  12
  13 use constant START_BOOTLEG_TEST => "A";
  14 use constant END_COMMUNICATION => "B";
  15 use constant SUCCESSFUL_TEST => "C";
  16 use constant UNSUCCESSFUL_TEST => "D";
  17 use constant SERVER_READY => "E";
  18 use constant BOOTLEG_MISMATCH => "F";
  19 use constant CLIENT_KILL => "G";
  20 use constant CLIENT_OK => "H";
  21 use constant GOT_BUILD_CLUSTER_VERSION => "I";
  22 use constant FAILED_GETTING_BUILD_CLUSTER_VERSION => "J";
  23 use constant START_UPKEEP => "K";
  24 use constant START_BOOTLEG_SEND => "L";
  25 use constant BOOTLEG_SEND_DIRECTORY => "M";
  26 use constant BOOTLEG_SEND_FILE => "N";
  27 use constant END_BOOTLEG_SEND => "O";
  28 use constant START_EMAIL => "P";
  29
  30 # ======================================================================
  31 # Globals
  32 # ======================================================================
  33
  34 my $name = $0;
  35 $name =~ s/^(.*)\\//;
  36
  37 my $branch;
  38 my $numbootlegs = 7;
  39 my $pdbtime = 14;
  40 my $bootlegnum = "";
  41 my $waittime = "60";
  42 my $port = "21498";
  43 my $build_cluster = "lin-vthakkar.station.sony.com";
  44 my $candela = "p:";
  45
  46 # ======================================================================
  47 # Subroutines
  48 # ======================================================================
  49
  50 sub usage
  51 {
  52         die "\n\t$name\n\n";
  53 }
  54
  55 sub perforceWhere
  56 {
  57         local $_;
  58
  59         # find out where a perforce file resides on the local machine
  60         my $result;
  61         {
  62                 open(P4, "p4 where $_[0] |");
  63                         $_ = <P4>;
  64                         chomp;
  65                         my @where = split;
  66                         $result = $where[2];
  67                 close(P4);
  68         }
  69
  70         return $result;
  71 }
  72
  73 sub reloop
  74 {
  75         print STDERR "Error with: $_[0]\n" if(defined $_[0]);
  76         print STDERR "Exiting this connection\n";
  77         goto FAIL;
  78 }
  79
  80 sub installBootleg
  81 {
  82         print "Installing bootleg...\n";
  83
  84         open(INSTALL, "perl " . perforceWhere("//depot/swg/current/tools/InstallBootleg.pl") . " --list --force_newest --client_only --no_database $branch |") or reloop "Error running InstallBootleg.pl\n";
  85
  86         my $complete = 0;
  87
  88         while(<INSTALL>)
  89         {
  90                 print;
  91                 $bootlegnum = $1 if(/^Updating to build: (\d+)/);
  92                 $complete = 1 if(/^Update complete/);
  93         }
  94
  95         close(INSTALL);
  96
  97         print "Bootleg installation incomplete\n" if(!$complete);
  98         print "Completed installing bootleg.\n" if($complete);
  99
 100         return $complete;
 101 }
 102
 103 sub error
 104 {
 105         my $message = shift @_;
 106         print SOCKET UNSUCCESSFUL_TEST;
 107         print STDERR "$message\n";
 108         goto FAIL;
 109 }
 110
 111 sub fatal
 112 {
 113         my $message = shift @_;
 114         print SOCKET UNSUCCESSFUL_TEST;
 115         close(SOCKET);
 116         die "$message\n";
 117 }
 118
 119 sub makeDir
 120 {
 121         my(@tok, $check);
 122         @tok = split(/\\|\//, $_[0]);
 123
 124         $check = shift(@tok);
 125         foreach (@tok)
 126         {
 127                 $check .= "/$_";
 128                 if(!(-d $check))
 129                 {
 130                         mkdir $check;
 131                 }
 132         }
 133
 134 }
 135
 136 sub recieveBootleg
 137 {
 138         my $buffer;
 139
 140         return 0 if (read(SOCKET, $buffer, 4) != 4);
 141         my $length = unpack("N", $buffer);
 142         return 0 if(read(SOCKET, $branch, $length) != $length);
 143         return 0 if (read(SOCKET, $buffer, 4) != 4);
 144         $bootlegnum = unpack("N", $buffer);
 145
 146         print STDERR "Recieving bootleg $branch/$bootlegnum...\n";
 147
 148         my $directory = "";
 149         while(1)
 150         {
 151                 return 0 if (read(SOCKET, $buffer, 1) != 1);
 152                 last if($buffer eq END_BOOTLEG_SEND);
 153
 154                 if($buffer eq BOOTLEG_SEND_DIRECTORY)
 155                 {
 156                         return 0 if (read(SOCKET, $buffer, 4) != 4);
 157                         $length = unpack("N", $buffer);
 158                         return 0 if (read(SOCKET, $directory, $length) != $length);
 159                         makeDir("$candela/SWO/swg_bootleg_builds/$branch/$bootlegnum/$directory");
 160                         chdir("$candela/SWO/swg_bootleg_builds/$branch/$bootlegnum/$directory") || reloop "Cannot chdir to $branch/$bootlegnum/$directory - $!\n";
 161                 }
 162                 if($buffer eq BOOTLEG_SEND_FILE)
 163                 {
 164                         return 0 if (read(SOCKET, $buffer, 2*4) != 2*4);
 165                         my ($fileNameLength, $fileSize) = unpack("NN", $buffer);
 166                         my $localFileName;
 167                         return 0 if (read(SOCKET, $localFileName, $fileNameLength) != $fileNameLength);
 168
 169                         print STDERR "Receiving $branch/$bootlegnum/$directory/$localFileName ($fileSize bytes)\n";
 170                         open(F, ">$localFileName") || reloop ("could not open $localFileName for writing");
 171                                 chmod (0755, $localFileName);
 172                                 binmode(F);
 173                                 while ($fileSize)
 174                                 {
 175                                         my $readSize = 16 * 1024;
 176                                         $readSize = $fileSize if ($fileSize < $readSize);
 177                                         my $readResult = read(SOCKET, $buffer, $readSize);
 178                                         reloop "socket to controller machine abruptly terminated ($fileSize bytes remained)\n" if (!defined($readResult));
 179                                         reloop "read incorrect amount ($fileSize bytes remained)\n" if ($readResult == 0);
 180                                         print F $buffer;
 181                                         $fileSize -= $readResult;
 182                                 }
 183                         endbootleginstall("copied wrong number of bytes") if ($fileSize != 0);
 184                         close(F);
 185                 }
 186         }
 187
 188         chdir("$candela/SWO/swg_bootleg_builds") || reloop "Cannot chdir to $candela - $!\n";;
 189
 190         print STDERR "Completed recieving bootleg $branch/$bootlegnum...\n";
 191 }
 192
 193 sub testBootleg
 194 {
 195         my $buffer;
 196         print STDERR "Initializing communication...\n";
 197
 198         error("problem reading from socket") if (read(SOCKET, $buffer, 4) != 4);
 199         my $length = unpack("N", $buffer);
 200         error("problem reading from socket") if(read(SOCKET, $branch, $length) != $length);
 201
 202         print STDERR "Testing bootleg for branch: $branch\n";
 203
 204         my $bootlegdir = perforceWhere("//depot/swg/$branch/bootleg/win32/...");
 205         $bootlegdir =~ s/\.{3}//;
 206
 207         chdir($bootlegdir) or reloop "Cannot change to bootleg directory\n";
 208
 209         installBootleg() || fatal "Error installing bootleg";
 210
 211         print SOCKET pack("N", $bootlegnum);
 212
 213         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 214         error("mismatch in client / server bootlegs")if($buffer eq BOOTLEG_MISMATCH);
 215         error("server not ready") if ($buffer ne SERVER_READY);
 216         print STDERR "Bootleg $bootlegnum verified with server - running client...\n";
 217
 218         my $killresult;
 219         my $swgpid = open(SWGCLIENT, "SwgClient_o.exe -- -s ClientGame loginServerAddress=$build_cluster skipIntro=true skipSplash=true autoConnectToLoginServer=true loginClientID=bootleg loginClientPassword=bootleg avatarName=\"bootleg bootleg\" autoConnectToGameServer=true autoQuitAfterLoadScreen=true -s SharedFoundation demoMode=true |");
 220         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 221         if($buffer eq CLIENT_KILL)
 222         {
 223                 kill 1, $swgpid;
 224                 error("Test unsuccessful - forced to kill client");
 225         }
 226         elsif($buffer eq CLIENT_OK)
 227         {
 228                 # make sure we give the client a chance to exit on its own, then attempt to kill
 229                 print "Waiting for $waittime seconds for the client to end on its own...\n";
 230                 sleep($waittime);
 231                 $killresult = kill 1, $swgpid;
 232         }
 233         close(SWGCLIENT);
 234
 235         # clientResult = 1 if return value of SwgClient == 0 and we did not have to kill it ($killresult = 0)
 236         my $clientResult = (!($? >> 8) && !$killresult);
 237         print "clientresult=$clientResult killresult=$killresult exitresult=$?\n";
 238
 239         print SOCKET ($clientResult == 1) ? SUCCESSFUL_TEST : UNSUCCESSFUL_TEST;
 240
 241         if($clientResult == 1)
 242         {
 243                 open(BLESS, ">$candela/SWO/swg_bootleg_builds/$branch/$bootlegnum/blessed.txt");
 244                 close(BLESS);
 245         }
 246
 247         print STDERR "Test was " . (($clientResult == 1) ? "successful\n" : "unsuccessful\n") . "\n";
 248 }
 249
 250
 251 sub upkeep
 252 {
 253         my $buffer;
 254
 255         return 0 if (read(SOCKET, $buffer, 4) != 4);
 256         my $length = unpack("N", $buffer);
 257         return 0 if(read(SOCKET, $branch, $length) != $length);
 258
 259         print STDERR "Performing upkeep on bootleg directory for $branch...\n";
 260
 261         my @bootlegs;
 262         my $removedbootlegs = 0;
 263         my $buildcluster;
 264
 265         print STDERR "Getting bootleg version on build cluster...\n";
 266         my $controller = perforceWhere("//depot/swg/current/tools/build_cluster_controller.pl");
 267
 268         open(BUILD, "perl $controller -bootleg-version 2>&1 |");
 269         while(<BUILD>)
 270         {
 271                 $buildcluster = $1 if(/^Build cluster bootleg version is: (\d+)/);
 272         }
 273         close(BUILD);
 274
 275         if(!defined $buildcluster)
 276         {
 277                 print STDERR "Could not get build cluster bootleg version.\n";
 278                 print SOCKET FAILED_GETTING_BUILD_CLUSTER_VERSION;
 279                 return 0;
 280         }
 281         else
 282         {
 283                 print STDERR "Build cluster bootleg version is $buildcluster.\n";
 284                 print SOCKET GOT_BUILD_CLUSTER_VERSION;
 285                 print SOCKET pack("N", $buildcluster);
 286         }
 287
 288         opendir DH, "$candela/SWO/swg_bootleg_builds/$branch" or fatal "Cannot open $candela/SWO/swg_bootleg_builds/$branch: $!\n";
 289         foreach (readdir DH)
 290         {
 291                 push @bootlegs, $_ if(/^\d+$/ && -d ("$candela/SWO/swg_bootleg_builds/$branch/$_"));
 292         }
 293         closedir DH;
 294
 295         @bootlegs = sort { $a <=> $b } @bootlegs;
 296
 297         while(@bootlegs > $numbootlegs)
 298         {
 299                 my $bootleg = shift @bootlegs;
 300                 next if($buildcluster == $bootleg);
 301
 302                 print STDERR "Removing bootleg $bootleg...\n";
 303                 system("rm -fr $candela/SWO/swg_bootleg_builds/$branch/$bootleg");
 304                 print SOCKET pack("N", $bootleg);
 305                 ++$removedbootlegs;
 306         }
 307         print SOCKET pack("N", 0);
 308         print STDERR "Completed upkeep on bootleg directory - removed $removedbootlegs bootlegs.\n";
 309
 310         my $removedpdbs = 0;
 311         print STDERR "Performing upkeep on pdb directory...\n";
 312         opendir DH, "$candela/SWO/pdbs" or fatal "Cannot open $candela/SWO/pdbs: $!\n";
 313         foreach (sort readdir DH)
 314         {
 315                 my $pdbfile = $_;
 316                 if($pdbfile =~ /^\d+_0_$branch\.zip$/ && -M "$candela/SWO/pdbs/$pdbfile" > $pdbtime)
 317                 {
 318                         print STDERR "Deleting $pdbfile...\n";
 319                         #system("rm -f $candela/SWO/pdbs/$pdbfile");
 320                         print SOCKET pack("N", length $pdbfile);
 321                         print SOCKET $pdbfile;
 322                         ++$removedpdbs;
 323                 }
 324         }
 325         closedir DH;
 326         print SOCKET pack("N", 0);
 327
 328         print STDERR "Completed upkeep on pdb directory - removed $removedpdbs pdbs.\n\n";
 329         return 1;
 330 }
 331
 332 sub endEmail
 333 {
 334         print SOCKET pack("N", 0);
 335         return 0;
 336 }
 337
 338 sub bootlegDirDescending
 339 {
 340         my($a, $b) = @_;
 341
 342         # Both are numbers
 343         return $b <=> $a if($a =~ /^\d+$/ && $b =~ /^\d+$/);
 344
 345         # Both are not numbers
 346         return $a cmp $b if(!($a =~ /^\d+$/) && !($b =~ /^\d+$/));
 347
 348         # $a is a number, $b is not
 349         return -1 if($a =~ /^\d+$/);
 350
 351         # $a is not a number, $ b is
 352         return 1;
 353 }
 354
 355 sub email
 356 {
 357         my $currentBootleg = "";
 358         my $oldBootleg = "";
 359         my $buffer;
 360         return endEmail() if(read(SOCKET, $buffer, 4) != 4);
 361         my $currentBootlegLength = unpack("N", $buffer);
 362         return endEmail() if($currentBootlegLength == 0);
 363         return endEmail() if(read(SOCKET, $currentBootleg, $currentBootlegLength) != $currentBootlegLength);
 364
 365         opendir DH, "$candela/SWO/swg_bootleg_builds/$branch" or fatal "Cannot open $candela/SWO/swg_bootleg_builds/$branch: $!\n";
 366         foreach (sort { bootlegDirDescending($b, $a) } readdir DH)
 367         {
 368                 # we want the 1st blessed one that is not the one we are looking at
 369                 next if($currentBootleg eq $_);
 370
 371                 if(/^\d+$/ && -d "$candela/SWO/swg_bootleg_builds/$branch/$_" && -f "$candela/SWO/swg_bootleg_builds/$branch/$_/blessed.txt")
 372                 {
 373                         $oldBootleg = $_;
 374                         last;
 375                 }
 376         }
 377         closedir DH;
 378
 379         print SOCKET pack("N", length $oldBootleg);
 380         print SOCKET $oldBootleg;
 381
 382         print STDERR "Completed sending information to build_bootleg_linux.\n";
 383 }
 384
 385 # ======================================================================
 386 # Main
 387 # ======================================================================
 388
 389 # open the daemon socket
 390 print STDERR "Opening socket\n";
 391 socket(LISTEN, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket failed\n";
 392 setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, 1) || die "setsockopt failed\n";
 393 my $addr = sockaddr_in($port, INADDR_ANY);
 394 bind(LISTEN, $addr) || die "bind failed\n";
 395 listen(LISTEN, 1) || die "listen failed\n";
 396
 397 BUILDLOOP:
 398 while (1)
 399 {
 400         print STDERR "Waiting on a connection...\n";
 401
 402         accept(SOCKET, LISTEN) || reloop "accept failed\n";
 403
 404         # make binary and unbuffer the socket
 405         binmode(SOCKET);
 406         my $oldSelect = select(SOCKET);
 407         $| = 1;
 408         select($oldSelect);
 409
 410         my $buffer;
 411         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 412
 413         if($buffer eq START_BOOTLEG_TEST)
 414         {
 415                 print "Got message to initiate bootleg test.\n";
 416                 testBootleg();
 417         }
 418         elsif($buffer eq START_UPKEEP)
 419         {
 420                 print "Got message to perform upkeep.\n";
 421                 upkeep();
 422         }
 423         elsif($buffer eq START_BOOTLEG_SEND)
 424         {
 425                 print "Got message to start recieving bootleg.\n";
 426                 recieveBootleg();
 427         }
 428         elsif($buffer eq START_EMAIL)
 429         {
 430                 print "Got message to start email.\n";
 431                 email();
 432         }
 433 FAIL:
 434         close(SOCKET);
 435 }