tools/build_cluster_daemon.pl

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Socket;
   6 use POSIX qw(setsid);
   7
   8 # ======================================================================
   9 # notes
  10 # add serverop user
  11 # remove dsrc from build cluster
  12 # ======================================================================
  13
  14 # ======================================================================
  15 # Constants
  16 # ======================================================================
  17
  18
  19 use constant START_COMMUNICATION => "S";
  20 use constant START_NOT_LOCKED_READY => "B";
  21 use constant START_LOCKED_READY => "C";
  22 use constant START_LOCKED_READY_UNAUTHORIZED_USER => "L";
  23 use constant START_ERROR_AUTHORIZING => "K";
  24
  25 use constant END_COMMUNICATION => "E";
  26 use constant END_SUCCESSFULL => "F";
  27
  28 use constant SUCCESSFULL_COMMAND => "P";
  29 use constant FAILED_COMMAND => "U";
  30 use constant UPDATE_BOOTLEG_STEP_OK => "G";
  31 use constant UPDATE_BOOTLEG_STEP_FAILED => "H";
  32 use constant UPDATE_BOOTLEG_SEND_DIRECTORY => "M";
  33 use constant UPDATE_BOOTLEG_FILES_FINISHED => "Q";
  34 use constant UPDATE_BOOTLEG_SEND_FILE => "N";
  35 use constant SNAPSHOT_FAILED => "O";
  36 use constant SNAPSHOT_SUCCESSFULL => "P";
  37
  38 use constant COMMAND_RESTART => "a";
  39 use constant COMMAND_RESTART_LOGIN => "b";
  40 use constant COMMAND_RESTART_NODES => "c";
  41 use constant COMMAND_LOCK => "d";
  42 use constant COMMAND_UNLOCK => "e";
  43 use constant COMMAND_UPDATE_BOOTLEG => "f";
  44 use constant COMMAND_CONTENT_SYNC => "g";
  45 use constant COMMAND_SYNC_SPECIFIED_CHANGELISTS => "h";
  46 use constant COMMAND_SNAPSHOT => "i";
  47 use constant COMMAND_BOOTLEG_VERSION => "j";
  48 use constant COMMAND_FREE_OBJECT_IDS => "k";
  49
  50 # ======================================================================
  51 # Globals
  52 # ======================================================================
  53
  54 my $p4 = "/usr/local/bin/p4";
  55 my $port = '98452';
  56 my $snapShotOutputFile = "/tmp/swg_object.txt";
  57 my $logfile = "build_cluster.log";
  58 my $depotdir = "/swo/";
  59 my $branch;
  60
  61 my @authorizedUsers =
  62 (
  63     "buildscript",
  64     "gmcdaniel",
  65     "ttyson",
  66     "tcramer",
  67     "sthomas"
  68 );
  69
  70 my $user = "none";
  71 my $keyuser = "none";
  72 my $serverdown = 0;
  73 my $email = 0;
  74 my %nodes;
  75
  76 my $name = $0;
  77 $name =~ s/^(.*)\\//;
  78
  79 # Access level:
  80 # 0 - Cluster is locked and incorrect user is trying to access
  81 # 1 - Cluster is unlocked
  82 # 2 - Cluster is locked and user is valid
  83 my $accesslevel = 0;
  84
  85 $ENV{"P4PORT"}   = "aus-perforce1.station.sony.com:1666";
  86 $ENV{"P4CLIENT"} = "serverop-swo-dev9";
  87
  88 # ======================================================================
  89 # Subroutines
  90 # ======================================================================
  91
  92 sub usage
  93 {
  94     print STDERR "\nUsage:\n";
  95     print STDERR "\t$name branch [-d <log file directory>]\n\n".
  96         "\t\tbranch : required perforce branch name (e.g. current or s7)\n".
  97         "\t\t-d     : daemonize script (e.g. -d /tmp/)\n";
  98     die "\n";
  99 }
 100
 101 sub prompt
 102 {
 103     print $_[0], "\n";
 104
 105     do
 106     {
 107         #print "Continue (y/n): ";
 108         $_ = "y"; # <STDIN>;
 109         return if (/^y/i);
 110         die "Aborting\n" if (/^n/i);
 111     } while (1);
 112 }
 113
 114 sub asksystem
 115 {
 116     print "Execute: $_[0]\n";
 117     do
 118     {
 119         #print "(y/n/A): ";
 120         $_ = "y"; # <STDIN>;
 121         return system($_[0]) if (/^y/i);
 122         return 0 if (/^n/i);
 123         die "Aborting\n" if (/^A/);
 124     } while (1);
 125 }
 126
 127 sub endFunc
 128 {
 129     writelog("Failed while running: $_[0]");
 130     print STDERR "Failed while running: $_[0]\n";
 131     return 0;
 132 }
 133
 134 sub perforceWhere
 135 {
 136     local $_;
 137
 138     # find out where a perforce file resides on the local machine
 139     my $result;
 140     {
 141         open(P4, "p4 where $_[0] |");
 142             $_ = <P4>;
 143             chomp;
 144             my @where = split;
 145             $result = $where[2];
 146         close(P4);
 147     }
 148
 149     return $result;
 150 }
 151
 152 sub writelog
 153 {
 154     my $message = shift @_;
 155     my ($sec, $min, $hr, $day, $mon, $yr) = localtime time;
 156     my $timestamp = sprintf "%4s-%02s-%02s\t%02s:%02s:%02s", ($yr + 1900), ($mon + 1), $day, $hr, $min, $sec;
 157     my $lock = locked() ? "locked" : "unlocked";
 158
 159     print LOG join("\t", $timestamp, $user, $lock, $message), "\n";
 160 }
 161
 162 sub initcommunication
 163 {
 164     my $buffer;
 165
 166     $user = "none";
 167     $keyuser = "none";
 168     $accesslevel = 0;
 169
 170     return endFunc("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 171
 172     my $length = unpack("N", $buffer);
 173
 174     return endFunc("Did not recieve enough bytes from socket (!= $length)") if(read(SOCKET, $buffer, $length) != $length);
 175
 176     if($buffer eq "buildscript")
 177     {
 178         writelog("Build script - bypassing key check");
 179         $accesslevel = 2;
 180         $user = "build_script";
 181         print SOCKET START_LOCKED_READY;
 182         return 1;
 183     }
 184
 185     $user = $buffer;
 186     my $isValidUser = grep($user eq $_, @authorizedUsers);
 187
 188     if(!locked())
 189     {
 190         # Cluster is unlocked
 191         $accesslevel = ($isValidUser == 0) ? 1 : 2;
 192         writelog("Communication initialized");
 193         print SOCKET START_NOT_LOCKED_READY;
 194         return 1;
 195     }
 196     elsif(!$isValidUser)
 197     {
 198         # Cluster is locked, and the and an unauthorized user is accessing
 199         $accesslevel = 0;
 200         writelog("Build locked and unauthorized user accessing");
 201         print SOCKET START_LOCKED_READY_UNAUTHORIZED_USER;
 202         return 1;
 203     }
 204     else
 205     {
 206         # Cluster is locked, and the user is valid
 207         $accesslevel = 2;
 208         writelog("Communication initialized");
 209         print SOCKET START_LOCKED_READY;
 210         return 1;
 211     }
 212 }
 213
 214 sub endcommunication
 215 {
 216     if(bringup() == 0)
 217     {
 218         writelog("Error bringing cluster back up");
 219         print SOCKET FAILED_COMMAND;
 220         return 0;
 221     }
 222
 223     print STDERR "Communication ended\n";
 224     writelog("Communication ended");
 225     print SOCKET END_SUCCESSFULL;
 226
 227     $user = "none";
 228     $keyuser = "none";
 229     $accesslevel = 0;
 230
 231     return 1;
 232 }
 233
 234 sub lockcluster
 235 {
 236     if($accesslevel == 2)
 237     {
 238         print STDERR "Locking build cluster...\n";
 239         asksystem("p4 counter swg-$branch-build-lockout 1");
 240         return 1;
 241     }
 242     else
 243     {
 244         print STDERR "Not authorized to lock build cluster...\n";
 245         return 0;
 246     }
 247 }
 248
 249 sub unlockcluster
 250 {
 251     if($accesslevel == 2)
 252     {
 253         print STDERR "Unlocking build cluster...\n";
 254         asksystem("p4 counter swg-$branch-build-lockout 0");
 255         return 1;
 256     }
 257     else
 258     {
 259         print STDERR "Not authorized to unlock build cluster...\n";
 260         return 0;
 261     }
 262
 263 }
 264
 265 sub locked
 266 {
 267     my $lock = `$p4 counter swg-$branch-build-lockout`;
 268     chomp $lock;
 269     return $lock;
 270 }
 271
 272 sub bringdown
 273 {
 274     if($serverdown == 0)
 275     {
 276         system("mail -s \"[BUILDCLUSTER] Build cluster coming down for a $_[0]\" swo\@soe.sony.com < /dev/null") == 0 || return endFunc("send email") if($email);
 277
 278         # stop the build cluster
 279         print STDERR "Bringing down the build cluster...\n";
 280         writelog("Bringing down the build cluster...");
 281         chdir("${depotdir}swg/$branch/exe/linux") || return endFunc("chdir");
 282         asksystem("./stopserver");
 283         $serverdown = 1;
 284     }
 285     return 1;
 286 }
 287
 288 sub bringup
 289 {
 290     if($serverdown == 1)
 291     {
 292         system("mail -s \"[BUILDCLUSTER] Build cluster coming back up\" swo\@soe.sony.com < /dev/null") == 0 || return endFunc("send email") if($email);
 293
 294         # bring the build cluster up normally
 295         print STDERR "Bringing up the build cluster for $branch...\n";
 296         writelog("Bringing up the build cluster for $branch...");
 297         chdir("${depotdir}swg/$branch/exe/linux") || return endFunc("Cannot change to ${depotdir}swg/$branch/exe/linux - $!");
 298         asksystem("echo start | debug/TaskManager -- \@buildTaskManager.cfg 2>&1 | tee taskManager.log &");
 299         $serverdown = 0;
 300     }
 301     return 1;
 302 }
 303
 304 sub restart
 305 {
 306     return endFunc("Incorrect access level - need > 0") if ($accesslevel < 1);
 307
 308     bringdown("restart") || errorcode("bringdown");
 309     bringup() || errorcode("bringup");
 310
 311     return 1;
 312 }
 313
 314 sub restartlogin
 315 {
 316     return endFunc("Incorrect access level - need > 0") if ($accesslevel < 1);
 317
 318     bringdown("restart login") || errorcode("bringdown");
 319
 320     writelog("Bringing down LoginServer");
 321     asksystem("killall -9 LoginServer");
 322
 323     asksystem("echo start | debug/LoginServer -- \@loginServer_buildCluster.cfg 2>&1 | tee loginServer.log &") == 0 || return endFunc("start LoginServer");
 324
 325     return 1;
 326 }
 327
 328 sub refreshnodes
 329 {
 330     writelog("Refreshing the list of nodes");
 331     %nodes = ();
 332
 333     open(LOCAL, "/swg/swg/$branch/exe/linux/localOptions.cfg") || return endFunc("error opening localOptions.cfg");
 334     while(<LOCAL>)
 335     {
 336         # Refresh all nodes, ignoring the head node
 337         $nodes{$1} = $2 if(/^node(\d+)=(\S+)/ && $1 != 0);
 338     }
 339     close(LOCAL);
 340
 341     writelog("Completed refreshing the list of nodes");
 342 }
 343
 344 sub bringnodesdown
 345 {
 346     return endFunc("Incorrect access level - need > 0") if ($accesslevel < 1);
 347
 348     writelog("Bringing down all nodes");
 349     my $remotecmd = "killall TaskManager";
 350
 351     foreach my $node (sort keys %nodes)
 352     {
 353         writelog("Bringing down $nodes{$node}");
 354         my $result = system("ssh -f serverop\@$nodes{$node} \"$remotecmd \"");
 355
 356         writelog("Error bringing down node $nodes{$node}") if($result != 0);
 357         }
 358
 359     return 1;
 360 }
 361
 362 sub bringnodesup
 363 {
 364     return endFunc("Incorrect access level - need > 0") if ($accesslevel < 1);
 365
 366     writelog("Bringing up all nodes");
 367     my $remotecmd = "ulimit -c unlimited; cd /swo/swg/$branch/exe/linux; debug/TaskManager -- \@remote_taskmanager.cfg";
 368
 369     foreach my $node (sort keys %nodes)
 370     {
 371         writelog("Bringing up $nodes{$node}");
 372         my $result = system("ssh -f serverop\@$nodes{$node} \"$remotecmd 2>&1 \" > logs/taskmanager-$nodes{$node}.log");
 373
 374         writelog("Error bringing up node $nodes{$node}") if($result != 0);
 375         }
 376
 377     return 1;
 378 }
 379
 380 sub restartnodes
 381 {
 382     return endFunc("Incorrect access level - need > 0") if ($accesslevel < 1);
 383
 384     refreshnodes() || errorcode("refreshnodelist");
 385     bringnodesdown() || errorcode("bringnodesdown");
 386     bringnodesup() || errorcode("bringnodesup");
 387
 388     return 1;
 389 }
 390
 391 sub endcontentsync
 392 {
 393     print SOCKET pack("N", 0);
 394     return endFunc($_[0]);
 395 }
 396
 397 sub runcontentsync
 398 {
 399     my ($change) = @_;
 400
 401     my $counter = `p4 counter swg-$branch-build-contentsync`;
 402     chomp $counter;
 403
 404     return endFunc("Cannot content sync before $branch counter ($change < $counter)") if($change < $counter);
 405
 406     my $messageToController = "";
 407     writelog("Content syncing from $counter to $change");
 408
 409     # Fix for a Malformed UTF-8 error in perl 5.8.0
 410     my $oldLang;
 411     if(exists $ENV{"LANG"})
 412     {
 413         $oldLang = $ENV{"LANG"};
 414         $ENV{"LANG"} = "en_US";
 415     }
 416
 417     open(CONTENTSYNC, "perl ${depotdir}swg/$branch/tools/ContentSync.pl 1 $branch $counter $change 2>&1 | ") || return endFunc("cannot open perl ContentSync.pl");
 418     while(<CONTENTSYNC>)
 419     {
 420         if(/^could not determine content status of /)
 421         {
 422             $messageToController .= $_;
 423             print STDERR $_;
 424             chomp;
 425             writelog($_);
 426         }
 427     }
 428     close(CONTENTSYNC);
 429
 430     $ENV{"LANG"} = $oldLang if(defined $oldLang);
 431
 432     print SOCKET pack("N", length $messageToController);
 433     print SOCKET $messageToController;
 434
 435     $change = $1 if($messageToController =~ /^could not determine content status of \S+ for changelist (\d+)/);
 436
 437     asksystem("p4 counter swg-$branch-build-contentsync $change") == 0 || return endFunc("Can't set counter swg-$branch-build-contentsync");
 438
 439     return 1;
 440 }
 441
 442
 443 sub contentsync
 444 {
 445     return endcontentsync("Incorrect access level - need > 0") if($accesslevel < 1);
 446
 447     bringdown("content sync") || return endcontentsync("bringdown");
 448
 449     # issue the content sync
 450     print STDERR "Content syncing...\n";
 451     chdir("${depotdir}swg/$branch/exe/linux") || endcontentsync("chdir");
 452
 453     my $buffer;
 454     return endcontentsync("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 455
 456     my $length = unpack("N", $buffer);
 457     my $end;
 458
 459     if($length != 0)
 460     {
 461         return endcontentsync("Did not recieve enough bytes from socket (!= $length)") if(read(SOCKET, $end, $length) != $length);
 462     }
 463     else
 464     {
 465         $end = `p4 counter change`;
 466         chomp $end;
 467     }
 468
 469     runcontentsync($end) || return endcontentsync("runcontentsync");
 470
 471     return 1;
 472 }
 473
 474 sub changelistsync
 475 {
 476     return endFunc("Incorrect access level - need > 0") if($accesslevel < 1);
 477
 478     bringdown("changelist sync") || errorcode("bringdown");
 479
 480     print STDERR "Syncing to changelists...\n";
 481     my $buffer;
 482
 483     return endFunc("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 484
 485     my $length = unpack("N", $buffer);
 486
 487     return endFunc("No changelists given") if ($length == 0);
 488
 489     return endFunc("Did not recieve enough bytes from socket (!= $length)") if (read(SOCKET, $buffer, $length) != $length);
 490
 491     my @cl = split / /, $buffer;
 492
 493     my $counter = `p4 counter swg-$branch-build-contentsync`;
 494     chomp $counter;
 495
 496     foreach (sort { $a <=> $b } @cl)
 497     {
 498         if($_ >= $counter)
 499         {
 500             writelog("Syncing to individual changelist $_");
 501             asksystem("$p4 sync //depot/swg/$branch/...\@$_,\@$_ > /dev/null 2>/dev/null") == 0 || return endFunc("Cannot sync //depot/swg/$branch/...\@$_,$_");
 502         }
 503         else
 504         {
 505             return endFunc("Cannot sync to a changelist less than contentsync ($_ < $counter)");
 506         }
 507     }
 508
 509     return 1;
 510 }
 511
 512 sub endsnap
 513 {
 514     print SOCKET SNAPSHOT_FAILED;
 515     return 0;
 516 }
 517
 518 sub makesnap
 519 {
 520     bringdown("snapshot") || errorcode("bringdown");
 521
 522     # get the name of the db schema to update
 523     my $buffer;
 524     my $dbSchema;
 525     return endsnap("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 526     my $length = unpack("N", $buffer);
 527     return endFunc("Did not recieve enough bytes from socket (!= $length)") if (read(SOCKET, $dbSchema, $length) != $length);
 528
 529     # create the gold schema user if not already created
 530     createuser($dbSchema);
 531
 532     # bring the build cluster up with preloading
 533     writelog("Bringing up the build cluster in preload mode");
 534     print STDERR "Bringing up the build cluster in preload mode...\n";
 535     prompt("unlinking localOptions.cfg");
 536     unlink("localOptions.cfg");
 537     prompt("symlinking localOptions.cfg to snapshotLocalOptions");
 538     symlink("snapshotLocalOptions.cfg", "localOptions.cfg") || return endsnap();
 539     prompt("bringing up the build cluster");
 540     my $result = system("echo start | debug/TaskManager -- \@buildTaskManagerPublishMode.cfg 2>&1 | tee taskManager.log");
 541
 542     # restore the normal config file
 543     writelog("Restoring the build cluster to normal mode");
 544     prompt("unlinking localOptions.cfg");
 545     unlink("localOptions.cfg");
 546     prompt("linking localOptions.cfg to normalLocalOptions.cfg");
 547     symlink("normalLocalOptions.cfg", "localOptions.cfg") || return endsnap();
 548
 549     # handle the cluster startup failing
 550     # return endsnap() if ($result != 0);
 551
 552     # copy to the publish cluster
 553     writelog("Copying to the publish database");
 554     print STDERR "Copying to the publish database...\n";
 555     chdir("${depotdir}swg/$branch/src/game/server/database/build/linux") || return endsnap();
 556
 557     my $copyBuildClusterLog = "${depotdir}swg/$branch/src/game/server/database/build/linux/copy_buildcluster.log";
 558     my $copyComplete = 0;
 559     $buffer = "";
 560     unlink($copyBuildClusterLog);
 561     open(DBLOG, "perl copy_buildcluster.pl --copybuildcluster --username=$dbSchema 2>&1 |") || return endsnap();
 562     while(<DBLOG>)
 563     {
 564         $buffer .= $_;
 565         $copyComplete = 1 if(/^Import terminated successfully/); # Note: ^IMP- and ^EXP- and ^ORA- warnings during import are normal operation
 566     }
 567     close(DBLOG);
 568     my $copyReturn = $?;
 569
 570     open (DBLOG, ">$copyBuildClusterLog");
 571     print DBLOG $buffer;
 572     close (DBLOG);
 573
 574     if ($copyReturn != 0 || $copyComplete == 0)
 575     {
 576         print STDERR "failed to copy the build cluster - output is in $copyBuildClusterLog\n";
 577         writelog("failed to copy the build cluster - output is in $copyBuildClusterLog");
 578         return endsnap();
 579     }
 580
 581     # Set the golddata schema name in the version_number table
 582     updateversion($dbSchema);
 583
 584     # execute the snapshot query
 585     writelog("Executing the world snapshot query");
 586     print STDERR "Executing the world snapshot query...\n";
 587     unlink($snapShotOutputFile);
 588     chdir("../../queries") || return endsnap();
 589     asksystem("sqlplus $dbSchema/changeme\@swodb \@world_snapshot.sql") == 0 || return endsnap();
 590
 591     # Here are the commands to run to do a new snapshot by hand
 592     # cd /swg/swg/test/exe/linux
 593     # rm -f *.ws snapshot.log
 594     # debug/SwgGameServer -- \@servercommon.cfg -s GameServer javaVMName=none -s WorldSnapshot createWorldSnapshots=/swg/swg/test/dsrc/sku.0/sys.client/built/game/snapshot/swg_object.txt 2> snapshot.log
 595     # p4 edit /swg/swg/test/data/sku.0/sys.client/built/game/snapshot/...
 596     # mv *.ws /swg/swg/test/data/sku.0/sys.client/built/game/snapshot
 597
 598     # build the snapshot files "debug/SwgGameServer -- @snapshot.cfg"
 599     writelog("Creating snapshot files");
 600     chdir("${depotdir}swg/$branch/exe/linux/") || return endsnap();
 601     system("rm -f *.ws snapshot.log");
 602     system("debug/SwgGameServer -- \@servercommon.cfg -s GameServer javaVMName=none -s WorldSnapshot createWorldSnapshots=$snapShotOutputFile 2> snapshot.log") == 0 || return endsnap();
 603
 604     print SOCKET SNAPSHOT_SUCCESSFULL;
 605
 606     # Send snapshot log, swg_object.txt, then all ws back to controller
 607     writelog("Transmitting snapshot files back to the controller");
 608     system("cp $snapShotOutputFile ${depotdir}swg/$branch/exe/linux/swg_object.txt");
 609     opendir DH, "${depotdir}swg/$branch/exe/linux/" or return endsnap();
 610     my @files;
 611     foreach(readdir DH)
 612     {
 613         push @files, $_ if($_ =~ /\.ws$/ && -s "${depotdir}swg/$branch/exe/linux/$_");
 614     }
 615     closedir DH;
 616
 617     @files = sort @files;
 618     unshift @files, "snapshot.log", "swg_object.txt";
 619
 620     foreach (@files)
 621     {
 622         my $file = $_;
 623
 624         my $fileSize = -s "${depotdir}swg/$branch/exe/linux/$_";
 625         print STDERR "Sending file $file ($fileSize bytes)\n";
 626         writelog("Sending file $file ($fileSize bytes)");
 627         print SOCKET pack("NN", $fileSize, length $file);
 628         print SOCKET $file;
 629         open(F, "<${depotdir}swg/$branch/exe/linux/$file");
 630             binmode(F);
 631             while ($fileSize)
 632             {
 633                 my $buffer;
 634                 my $readSize = 16 * 1024;
 635                 $readSize = $fileSize if ($fileSize < $readSize);
 636                 my $readResult = read(F, $buffer, $readSize);
 637                 return endFunc("readResult not defined") if (!defined($readResult));
 638                 return endFunc("readResult not equal to readSize") if ($readResult != $readSize);
 639                 print SOCKET $buffer;
 640                 $fileSize -= $readResult;
 641             }
 642             return endFunc("copied all the bytes but not at EOF") if (!eof(F));
 643         close(F);
 644
 645         print STDERR "$file sent.\n";
 646         writelog("$file sent");
 647     }
 648
 649     print SOCKET pack("NN", 0, 0);
 650
 651     return 1;
 652 }
 653
 654 sub endbootleginstall
 655 {
 656     print SOCKET UPDATE_BOOTLEG_STEP_FAILED;
 657     return endFunc($_[0]);
 658 }
 659
 660 sub bootleginstall
 661 {
 662     if($accesslevel == 2)
 663     {
 664         bringdown("exe update") || errorcode("bringdown");
 665
 666         writelog("Bringing down LoginServer");
 667         asksystem("killall -9 LoginServer");
 668
 669         refreshnodes() || return endFunc("refreshnodes");
 670         bringnodesdown() || return endFunc("bringnodesdown");
 671
 672         print STDERR "Installing most recent bootleg...\n";
 673
 674         my $buffer;
 675         # Sync to bootleg number
 676         return endbootleginstall("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 677         my $change = unpack("N", $buffer);
 678         print STDERR "Syncing to $change...\n";
 679         writelog("Syncing to $change...");
 680         asksystem("p4 sync //depot/swg/$branch/...\@$change 2>&1") == 0 || return endbootleginstall("p4 sync failed");
 681         writelog("Sync to $change complete");
 682         print STDERR "Sync to $change complete\n";
 683         print SOCKET UPDATE_BOOTLEG_STEP_OK;
 684
 685         # Get exes for bootleg
 686         chdir("${depotdir}swg/$branch/exe/linux/") || return endbootleginstall("chdir");
 687         writelog("Recieving files...");
 688
 689         return endbootleginstall("Did not recieve enough bytes from socket (!= 8)") if (read(SOCKET, $buffer, 2*4) != 2*4);
 690         my ($fileSize, $fileNameLength) = unpack("NN", $buffer);
 691
 692         my $localFileName;
 693         return endbootleginstall("Did not recieve enough bytes from socket (!= $fileNameLength)") if (read(SOCKET, $localFileName, $fileNameLength) != $fileNameLength);
 694
 695         # receive the binary bits for the file
 696         print STDERR "Receiving $localFileName ($fileSize bytes)\n";
 697         writelog("Receiving $localFileName ($fileSize bytes)");
 698         unlink $localFileName;
 699         open(F, ">" . $localFileName) || return endbootleginstall("could not open $localFileName for writing");
 700             chmod (0755, $localFileName);
 701             binmode(F);
 702             while ($fileSize)
 703             {
 704                 my $readSize = 16 * 1024;
 705                 $readSize = $fileSize if ($fileSize < $readSize);
 706                 my $readResult = read(SOCKET, $buffer, $readSize);
 707                 return endbootleginstall("socket to controller machine abruptly terminated ($fileSize bytes remained)") if (!defined($readResult));
 708                 return endbootleginstall("read incorrect amount ($fileSize bytes remained)") if ($readResult == 0);
 709                 print F $buffer;
 710                 $fileSize -= $readResult;
 711             }
 712         return endbootleginstall("copied wrong number of bytes") if ($fileSize != 0);
 713         close(F);
 714
 715         writelog("Untarring servers file");
 716         chdir("${depotdir}swg/$branch/exe/linux/debug");
 717         my $result = system("tar -xzf ../$localFileName &> /dev/null");
 718         return endbootleginstall("error untarring server files") if ($result != 0);
 719         system("chmod -R 755 *");
 720
 721         print SOCKET UPDATE_BOOTLEG_STEP_OK;
 722         writelog("Recieve successful");
 723
 724         # Update database
 725         print STDERR "Updating database...\n";
 726         writelog("Updating database");
 727
 728         chdir("${depotdir}swg/$branch/src/game/server/database/build/linux/") || endbootleginstall("Cannot change to database dir $!");
 729
 730         my $update_complete = 1;
 731         $buffer = "";
 732         open(DBLOG, "perl database_update.pl --delta --username=buildcluster --buildcluster |") || endbootleginstall("database_update failed");
 733         while(<DBLOG>)
 734         {
 735             $buffer .= $_;
 736             $update_complete = 0 if(/ERROR/);
 737         }
 738         close(DBLOG);
 739
 740         return endbootleginstall("Error while updating database:\n$buffer") if(!$update_complete);
 741         print SOCKET UPDATE_BOOTLEG_STEP_OK;
 742         writelog("Update database complete");
 743         print STDERR "Update database complete\n";
 744
 745         writelog("Updating individual changelists from sync.txt");
 746         return endFunc("Did not recieve enough bytes from socket (!= 4)") if (read(SOCKET, $buffer, 4) != 4);
 747         my $length = unpack("N", $buffer);
 748         writelog("Expecting individual changelist string of length " . $length);
 749         return endFunc("No changelists given") if ($length == 0);
 750         return endFunc("Did not recieve enough bytes from socket (!= $length)") if (read(SOCKET, $buffer, $length) != $length);
 751         my @changelists = split / /, $buffer;
 752         foreach (@changelists)
 753         {
 754             system("p4 sync //depot/swg/$branch/...\@$_,\@$_");
 755         }
 756         writelog("Done updating individual changelists from sync.txt");
 757         print SOCKET UPDATE_BOOTLEG_STEP_OK;
 758
 759         writelog("Bringing back up LoginServer");
 760         chdir("${depotdir}swg/$branch/exe/linux") || return endFunc("Cannot change to ${depotdir}swg/$branch/exe/linux - $!");
 761         asksystem("echo start | debug/LoginServer -- \@loginServer_buildCluster.cfg 2>&1 | tee loginServer.log &") == 0 || return endbootleginstall("start LoginServer");
 762
 763         bringnodesup() || return endFunc("bringnodesup");
 764
 765         print STDERR "Bootleg update complete.\n";
 766         writelog("Bootleg update complete");
 767         return 1;
 768     }
 769     else
 770     {
 771         print STDERR "Not authorized to update bootleg...\n";
 772         return 0;
 773     }
 774 }
 775
 776 sub getbootlegversion
 777 {
 778     print STDERR "Getting bootleg version\n";
 779     my $bootlegver;
 780     open(VER, perforceWhere("//depot/swg/$branch/tools/VersionNumber") . " -r /swg/swg/$branch/exe/linux/debug/lib/libsharedFoundation.so |");
 781     while(<VER>)
 782     {
 783         $bootlegver = $1 if(/ \d+\.(\d+) (bootleg|publish)/);
 784     }
 785     close(VER);
 786
 787     if(!defined $bootlegver)
 788     {
 789         print SOCKET pack("N", 0);
 790         return endFunc("Could not get VersionNumber from file");
 791     }
 792
 793     print SOCKET pack("N", length $bootlegver);
 794     print SOCKET $bootlegver;
 795     print "Build cluster bootleg version is: $bootlegver\n";
 796     writelog("Build cluster bootleg version is: $bootlegver");
 797
 798     return 1;
 799 }
 800
 801 sub snapobjectiderror
 802 {
 803     print SOCKET pack("N", 0);
 804     errorcode("freeobjectids");
 805 }
 806
 807 sub freeobjectids
 808 {
 809     print STDERR "Freeing object ids\n";
 810
 811     my $tmpfile = "freeobjectids.tmp";
 812     open(TMPFILE, ">$tmpfile");
 813     print TMPFILE "exec objectidmanager.rebuild_freelist\;";
 814     print TMPFILE "delete from free_object_ids where end_id is null\;";
 815     print TMPFILE "Commit\;";
 816     close(TMPFILE);
 817
 818     my $buffer = "";
 819     my $error = 0;
 820     open(SQL, "sqlplus buildcluster/changeme\@swodb < freeobjectids.tmp |") || return endFunc("sqlplus buildcluster/changeme\@swodb < freeobjectids.tmp");
 821     while(<SQL>)
 822     {
 823         $buffer .= $_;
 824         $error = 1 if(/ERROR/);
 825     }
 826     close(SQL);
 827
 828     unlink($tmpfile);
 829
 830     if($error)
 831     {
 832         writelog("Error freeing object IDs");
 833         writelog($buffer);
 834         return endFunc("freeing object ids");
 835     }
 836     else
 837     {
 838         writelog("Successfully freed object ids");
 839         print STDERR "Successfully freed object ids\n";
 840         return 1;
 841     }
 842 }
 843
 844 sub updateversion
 845 {
 846     my $dbSchema = uc shift;
 847
 848     print STDERR "Updating version [$dbSchema]\n";
 849
 850     my $tmpfile = "updateversion.tmp";
 851     open(TMPFILE, ">$tmpfile");
 852     print TMPFILE "UPDATE VERSION_NUMBER SET GOLDDATA='$dbSchema';\n";
 853     print TMPFILE "COMMIT;\n";
 854     close(TMPFILE);
 855
 856     my $buffer = "";
 857     my $error = 0;
 858
 859     open(SQL, "sqlplus $dbSchema/changeme\@swodb < updateversion.tmp |") || return endFunc("sqlplus $dbSchema/changeme\@swodb < updateversion.tmp");
 860     while(<SQL>)
 861     {
 862         $buffer .= $_;
 863         $error = 1 if(/ERROR/);
 864     }
 865     close(SQL);
 866
 867     unlink($tmpfile);
 868
 869     if($error)
 870     {
 871         writelog("Error updating version");
 872         writelog($buffer);
 873         return endFunc("update version");
 874     }
 875     else
 876     {
 877         writelog("Successfully updated version");
 878         print STDERR "Successfully updated version\n";
 879         return 1;
 880     }
 881 }
 882
 883 sub hasuser
 884 {
 885     my ($dbSchema, $dbUser, $dbPass) = @_;
 886
 887     print STDERR "Checking if user exists [$dbSchema]\n";
 888
 889     my $tmpfile = "hasuser.tmp";
 890     open(TMPFILE, ">$tmpfile");
 891         print TMPFILE "SELECT USERNAME FROM DBA_USERS WHERE USERNAME = '$dbSchema';\n";
 892     close(TMPFILE);
 893     my $found = 1;
 894
 895     open(SQL, "sqlplus $dbUser/$dbPass\@swodb < hasuser.tmp |") || return endFunc("sqlplus < hasuser.tmp");
 896     while(<SQL>)
 897     {
 898         $found = 0 if(/no rows selected/);
 899     }
 900     close(SQL);
 901
 902     unlink($tmpfile);
 903
 904     if($found)
 905     {
 906         writelog("User found");
 907         print STDERR "User found\n";
 908     }
 909     else
 910     {
 911         writelog("User not found");
 912         print STDERR "User not found\n";
 913     }
 914
 915     return $found;
 916 }
 917
 918 sub createuser
 919 {
 920     if (!defined($ENV{BUILD_CLUSTER_USER}) || !defined($ENV{BUILD_CLUSTER_PASS}))
 921     {
 922         print STDERR "DBA user environment variables not set correctly for automatic user creation\n";
 923         return;
 924     }
 925
 926     my $dbSchema = uc shift;
 927     my $dbUser = $ENV{BUILD_CLUSTER_USER};
 928     my $dbPass = $ENV{BUILD_CLUSTER_PASS};
 929
 930     return if hasuser($dbSchema, $dbUser, $dbPass);
 931
 932     print STDERR "Creating new user [$dbSchema]\n";
 933
 934     my $tmpfile = "createuser.tmp";
 935     open(TMPFILE, ">$tmpfile");
 936     print TMPFILE "CREATE USER \"$dbSchema\"  PROFILE \"DEFAULT\"\n";
 937     print TMPFILE "    IDENTIFIED BY \"changeme\" DEFAULT TABLESPACE \"DATA\"\n";
 938     print TMPFILE "    TEMPORARY TABLESPACE \"TEMP\"\n";
 939     print TMPFILE "    ACCOUNT UNLOCK;\n";
 940     print TMPFILE "GRANT CREATE TYPE TO \"$dbSchema\";\n";
 941     print TMPFILE "GRANT UNLIMITED TABLESPACE TO \"$dbSchema\";\n";
 942     print TMPFILE "GRANT \"SWG_GENERAL\" TO \"$dbSchema\";\n";
 943     close(TMPFILE);
 944
 945     my $buffer = "";
 946     my $error = 0;
 947
 948     open(SQL, "sqlplus $dbUser/$dbPass\@swodb < createuser.tmp |") || return endFunc("sqlplus < createuser.tmp");
 949     while(<SQL>)
 950     {
 951         $buffer .= $_;
 952         $error = 1 if(/ERROR/);
 953     }
 954     close(SQL);
 955
 956     unlink($tmpfile);
 957
 958     if($error)
 959     {
 960         writelog("Error creating user");
 961         writelog($buffer);
 962         return endFunc("create user");
 963     }
 964     else
 965     {
 966         writelog("Successfully created user");
 967         print STDERR "Successfully created user\n";
 968         return 1;
 969     }
 970 }
 971
 972 sub errorcode
 973 {
 974     writelog("Failed while running $_[0]");
 975     print STDERR "Failed while running: $_[0]\n";
 976     print SOCKET FAILED_COMMAND;
 977     bringup();
 978     endcommunication();
 979     close(SOCKET);
 980     goto BUILDLOOP;
 981 }
 982
 983 # ======================================================================
 984 # Main
 985 # ======================================================================
 986 usage() if(@ARGV != 1 && @ARGV != 3);
 987
 988 $branch = shift;
 989
 990 usage() unless ($branch =~ m/^(current|test|stage|live|x\d+|ep3|s\d+)$/);
 991
 992 # handle running as a daemon
 993 # usage is $name branch [-d <directory where daemon log file should be placed>]
 994 if (@ARGV == 2 && $ARGV[0] eq "-d")
 995 {
 996     open STDIN, "/dev/null";
 997     open STDOUT, "/dev/null";
 998
 999     # run as a daemon
1000     my $pid = fork;
1001     die "$0: fork failed" if (!defined $pid);
1002
1003     # parent process should exit
1004     exit 0 if ($pid != 0);
1005
1006     # create a new session
1007     setsid || die "$0: setsid failed";
1008
1009     chdir($ARGV[1]) or die "cannot change directry to $ARGV[1]";
1010
1011     open STDERR, "/dev/null";
1012 }
1013
1014 # ignore sigpipe
1015 $SIG{'PIPE'} = 'IGNORE';
1016
1017 # open the log file
1018 open(LOG, ">>$logfile");
1019 my $oldSelect = select(LOG);
1020 $| = 1;
1021 select($oldSelect);
1022
1023 writelog("Starting running branch $branch");
1024
1025 # open the daemon socket
1026 print STDERR "Opening socket\n";
1027 writelog("Opening socket");
1028 socket(LISTEN, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket failed\n";
1029 setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, 1) || die "setsockopt failed\n";
1030 my $addr = sockaddr_in($port, INADDR_ANY);
1031 bind(LISTEN, $addr) || die "bind failed\n";
1032 listen(LISTEN, 1) || die "listen failed\n";
1033
1034 BUILDLOOP:
1035 while (1)
1036 {
1037     print STDERR "Waiting on a connection...\n";
1038
1039     accept(SOCKET, LISTEN) || die "accept failed\n";
1040
1041     # make binary and unbuffer the socket
1042     binmode(SOCKET);
1043     $oldSelect = select(SOCKET);
1044     $| = 1;
1045     select($oldSelect);
1046
1047     my $mode;
1048     goto FAIL if (read(SOCKET, $mode, 1) != 1);
1049
1050     if($mode eq START_COMMUNICATION)
1051     {
1052         print STDERR "Initializing communication\n";
1053         writelog("Initializing communication");
1054         initcommunication() || errorcode("initcommunication");
1055
1056         while(1)
1057         {
1058             goto FAIL if (read(SOCKET, $mode, 1) != 1);
1059
1060             # Restart the build cluster
1061             if($mode eq COMMAND_RESTART)
1062             {
1063                 writelog("Restarting");
1064                 restart() || errorcode("restart");
1065                 print SOCKET SUCCESSFULL_COMMAND;
1066             }
1067             # Restart the login server on the build cluster
1068             elsif($mode eq COMMAND_RESTART_LOGIN)
1069             {
1070                 writelog("Restarting login");
1071                 restartlogin() || errorcode("restart login");
1072                 print SOCKET SUCCESSFULL_COMMAND;
1073             }
1074             # Restart the nodes on the build cluster
1075             elsif($mode eq COMMAND_RESTART_NODES)
1076             {
1077                 writelog("Restarting nodes");
1078                 restartnodes() || errorcode("restart nodes");
1079                 print SOCKET SUCCESSFULL_COMMAND;
1080             }
1081             # Lock build cluster
1082             elsif($mode eq COMMAND_LOCK)
1083             {
1084                 writelog("Locking");
1085                 lockcluster() || errorcode("lock");
1086                 print SOCKET SUCCESSFULL_COMMAND;
1087             }
1088             # Unlock build cluster
1089             elsif($mode eq COMMAND_UNLOCK)
1090             {
1091                 writelog("Unlocking");
1092                 unlockcluster() || errorcode("unlock");
1093                 print SOCKET SUCCESSFULL_COMMAND;
1094             }
1095             # Bootleg
1096             elsif($mode eq COMMAND_UPDATE_BOOTLEG)
1097             {
1098                 writelog("Update bootleg");
1099                 bootleginstall() || errorcode("bootleginstall");
1100                 print SOCKET SUCCESSFULL_COMMAND;
1101             }
1102             # Content sync
1103             elsif($mode eq COMMAND_CONTENT_SYNC)
1104             {
1105                 writelog("Content syncing");
1106                 contentsync() || errorcode("contentsync");
1107                 print SOCKET SUCCESSFULL_COMMAND;
1108             }
1109             # Sync specific changelists
1110             elsif($mode eq COMMAND_SYNC_SPECIFIED_CHANGELISTS)
1111             {
1112                 writelog("Changelist syncing");
1113                 changelistsync() || errorcode("changelistsync");
1114                 print SOCKET SUCCESSFULL_COMMAND;
1115             }
1116             # Snapshot
1117             elsif($mode eq COMMAND_SNAPSHOT)
1118             {
1119                 writelog("Snapshot");
1120                 freeobjectids || snapobjectiderror("freeobjectids");
1121                 makesnap() || errorcode("makesnap");
1122                 print SOCKET SUCCESSFULL_COMMAND;
1123             }
1124             elsif($mode eq COMMAND_BOOTLEG_VERSION)
1125             {
1126                 writelog("Checking bootleg version");
1127                 getbootlegversion() || errorcode("getbootlegversion");
1128                 print SOCKET SUCCESSFULL_COMMAND;
1129             }
1130             elsif($mode eq COMMAND_FREE_OBJECT_IDS)
1131             {
1132                 writelog("Freeing object IDs");
1133                 freeobjectids() || errorcode("freeobjectids");
1134                 print SOCKET SUCCESSFULL_COMMAND;
1135             }
1136             elsif($mode eq END_COMMUNICATION)
1137             {
1138                 print STDERR "Ending communication\n";
1139                 writelog("Ending communication");
1140                 endcommunication() || errorcode("endcommunication");
1141                 last;
1142             }
1143             else
1144             {
1145                 writelog("Unrecognized command : $mode");
1146                 goto FAIL;
1147             }
1148         }
1149     }
1150     else
1151     {
1152         errorcode("waiting for start message");
1153     }
1154
1155 FAIL:
1156     # done with the socket
1157     close(SOCKET);
1158 }
1159
1160 close(LOG);