tools/test_build_linux.pl

   1 #! /usr/bin/perl
   2 # ======================================================================
   3 # ======================================================================
   4
   5 use warnings;
   6 use strict;
   7 use Socket;
   8 use Getopt::Long;
   9 use File::Copy;
  10
  11 # ======================================================================
  12 # Constants
  13 # ======================================================================
  14
  15 use constant START_BOOTLEG_TEST => "A";
  16 use constant END_COMMUNICATION => "B";
  17 use constant SUCCESSFUL_TEST => "C";
  18 use constant UNSUCCESSFUL_TEST => "D";
  19 use constant SERVER_READY => "E";
  20 use constant BOOTLEG_MISMATCH => "F";
  21 use constant CLIENT_KILL => "G";
  22 use constant CLIENT_OK => "H";
  23
  24 # ======================================================================
  25 # Globals
  26 # ======================================================================
  27
  28 my $scriptName = $0;
  29 $scriptName =~ s/^(.*)\\//;
  30
  31 my $depotdir = "/swg";
  32 my $builddir = "/mnt/misc/builds";
  33 my $logfile = "test_build.log";
  34 my $win32machine = "64.37.133.173";
  35 my $port = "98514";
  36 my $emailRecipients = "vthakkar\@soe.sony.com";
  37
  38 my $waittime = "180";
  39 my $branch = "";
  40 my $oldbootleg = "";
  41 my $newbootleg = "";
  42 my $loginpid;
  43 my $taskpid;
  44
  45 my $numbootlegs = 7;
  46
  47 my @steps = (0, 0, 0, 0);
  48
  49 # ======================================================================
  50 # Subroutines
  51 # ======================================================================
  52
  53 sub usage
  54 {
  55         print "\n\t$scriptName <optional parameters> <branch>\n\n".
  56                 "\tOptional parameters:\n\n".
  57                 "\t\t--install\t: Install newest build\n".
  58                 "\t\t--test\t\t: Test build\n".
  59                 "\t\t--email\t\t: Send email about results\n".
  60                 "\t\t--upkeep\t: Perform upkeep on bootleg directories\n";
  61         die "\n";
  62 }
  63
  64 sub writelog
  65 {
  66         my $message = shift @_;
  67         chomp $message;
  68         my ($sec, $min, $hr, $day, $mon, $yr) = localtime time;
  69         my $timestamp = sprintf "%4s-%02s-%02s\t%02s:%02s:%02s", ($yr + 1900), ($mon + 1), $day, $hr, $min, $sec;
  70
  71         print LOG join("\t", $timestamp, $message), "\n";
  72 }
  73
  74 sub fatal
  75 {
  76         my $message = shift @_;
  77         print "Fatal error running: $message\n";
  78         writelog("Fatal error running: $message");
  79         close(LOG);
  80         die;
  81 }
  82
  83 sub unbuffer
  84 {
  85         my $oldSelect = select($_[0]);
  86         $| = 1;
  87         select($oldSelect);
  88 }
  89
  90 sub unbufferReadline
  91 {
  92         my ($fh) = @_;
  93         my $buffer;
  94         my $return = "";
  95         while(sysread($fh, $buffer, 1))
  96         {
  97                 $return .= $buffer;
  98                 last if($buffer eq "\n");
  99         }
 100         return $return;
 101 }
 102
 103 sub perforceWhere
 104 {
 105         local $_;
 106
 107         # find out where a perforce file resides on the local machine
 108         my $result;
 109         {
 110                 open(P4, "p4 where $_[0] |");
 111                         $_ = <P4>;
 112                         chomp;
 113                         my @where = split;
 114                         $result = $where[2];
 115                 close(P4);
 116         }
 117
 118         return $result;
 119 }
 120
 121
 122 sub openClientSocket
 123 {
 124         socket(SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || closeServer("socket failed\n");
 125         {
 126                 my $destination = inet_aton($win32machine) || closeServer("inet_aton failed\n");
 127                 my $paddr = sockaddr_in($port, $destination);
 128                 connect(SOCKET, $paddr) || closeServer("connect failed\n");
 129
 130                 # unbuffer the socket
 131                 my $oldSelect = select(SOCKET);
 132                 $| = 1;
 133                 select($oldSelect);
 134
 135                 # put the socket into binary mode
 136                 binmode SOCKET;
 137         }
 138 }
 139
 140 sub getCurrentBootleg
 141 {
 142         my $bootleg = 0;
 143
 144         open(VER, perforceWhere("//depot/swg/$branch/tools/VersionNumber") . " -r ".perforceWhere("//depot/swg/$branch/bootleg/linux/debug/lib/libsharedFoundataion.so")." |");
 145         while(<VER>)
 146         {
 147                 $bootleg = $1 if(/\s(\d+)\.0 bootleg/);
 148         }
 149         close(VER);
 150
 151         return $bootleg;
 152 }
 153
 154
 155 sub installBootleg
 156 {
 157         print "Installing bootleg...\n";
 158         writelog("Installing bootleg");
 159
 160         open(INSTALL, "perl " . perforceWhere("//depot/swg/current/tools/InstallBootleg.pl") . " --list --force_newest --server_only --install_as_build_cluster --update_database $branch |") or fatal "Error running InstallBootleg.pl\n";
 161
 162         my $complete = 0;
 163
 164         while(<INSTALL>)
 165         {
 166                 print;
 167                 writelog($_);
 168                 $complete = 1 if(/^Update complete\./);
 169                 $oldbootleg = $1 if($oldbootleg eq "" && /^\d+\s+(\d+)\s+blessed/);
 170                 $newbootleg = $1 if(/^Updating to build: (\d+)/);
 171         }
 172
 173         close(INSTALL);
 174
 175         print "Bootleg installation incomplete\n" if(!$complete);
 176         print "Completed installing bootleg.\n\n" if($complete);
 177         writelog("OldBootleg: $oldbootleg, InstallBootleg complete: $complete");
 178
 179         return $complete;
 180 }
 181
 182 sub closeServer
 183 {
 184         print "Fatal Error: Killing forked processes\n";
 185         endServer();
 186         fatal $_[0];
 187 }
 188
 189 sub startServer
 190 {
 191         my $loginServer = "debug/LoginServer";
 192         my $taskManager = "debug/TaskManager";
 193
 194         writelog("Starting Server");
 195         my $serverdir = perforceWhere("//depot/swg/$branch/bootleg/linux/fakefile");
 196         $serverdir =~ s/fakefile$//;
 197         chdir($serverdir) || fatal "Cannot change directory to $serverdir\n";
 198
 199         print "Starting up server...\n";
 200         $loginpid = open(LOGINSERVER, "$loginServer -- \@loginServer.cfg 2>&1 |") or closeServer("Can't open LoginServer\n");
 201         binmode LOGINSERVER;
 202
 203         while(<LOGINSERVER>)
 204         {
 205                 writelog("LoginServer: $_") if(/\S+/);
 206                 last if(/^Cluster \d+:/);
 207         }
 208
 209         $taskpid = open(TASKMANAGER, "$taskManager -- \@taskmanager.cfg 2>&1 |") or closeServer("Can't open TaskManager\n");
 210         binmode TASKMANAGER;
 211
 212         while(<TASKMANAGER>)
 213         {
 214                 writelog("TaskManager: $_") if(/\S+/);
 215                 last if(/^Preload finished on all planets/);
 216         }
 217 }
 218
 219 sub endServer
 220 {
 221         writelog("Ending Server");
 222         print "Shutting down server.\n";
 223         kill 1, $taskpid if(defined $taskpid);
 224         kill 1, $loginpid if(defined $loginpid);
 225         system("killall CommoditiesServer");
 226         system("killall ChatServer");
 227         close(TASKMANAGER);
 228         close(LOGINSERVER);
 229 }
 230
 231 sub startClient
 232 {
 233         writelog("Starting Client");
 234         print "Starting up client...\n";
 235
 236         openClientSocket();
 237
 238         print SOCKET START_BOOTLEG_TEST;
 239         print SOCKET pack("N", length $branch);
 240         print SOCKET $branch;
 241 }
 242
 243 sub endClient
 244 {
 245         writelog("Ending Client");
 246         print SOCKET CLIENT_KILL;
 247         print "Shutting down client.\n";
 248         close(SOCKET);
 249 }
 250
 251 sub checkResponses
 252 {
 253         writelog("Verifying server and client responses");
 254         my $loginsuccess = 0;
 255         my $tasksuccess = 0;
 256         my $buffer;
 257
 258         print "Verifying client and server have same bootleg installation.\n";
 259         read(SOCKET, $buffer, 4) == 4 or fatal "Error reading from win32 machine\n";
 260         my $clientbootleg = unpack("N", $buffer);
 261
 262         $newbootleg = getCurrentBootleg() if(!defined $newbootleg);
 263
 264         if($clientbootleg ne $newbootleg)
 265         {
 266                 writelog("Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg");
 267                 print "Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg\n";
 268                 print SOCKET BOOTLEG_MISMATCH;
 269                 return 0;
 270         }
 271         print "Both client and server have bootleg $newbootleg installed\n";
 272         writelog("Both client and server have bootleg $newbootleg installed");
 273
 274         print SOCKET SERVER_READY;
 275
 276         my $starttime = time;
 277         writelog("Beginning test with client - timeout of $waittime seconds");
 278
 279         # used to create non-blocking reading of both filehandles
 280         while(1)
 281         {
 282                 my $rin = '';
 283                 my $rout;
 284                 my $line;
 285                 vec($rin, fileno(LOGINSERVER), 1) = 1;
 286                 vec($rin, fileno(TASKMANAGER), 1) = 1;
 287
 288                 if(select($rout=$rin, undef, undef, 0))
 289                 {
 290                         if (vec($rout, fileno(LOGINSERVER), 1))
 291                         {
 292                                 $line = unbufferReadline(\*LOGINSERVER);
 293                                 if(defined $line)
 294                                 {
 295                                         writelog("LoginServer: $line") if($line =~ /\S+/);
 296                                         ++$loginsuccess if($loginsuccess == 0 && $line =~ /^connection opened for service on port \d+/);
 297                                         ++$loginsuccess if($loginsuccess == 1 && $line =~ /^Encrypting with key:/);
 298                                         ++$loginsuccess if($loginsuccess == 2 && $line =~ /^Client connected\.  Station Id:  \d+, Username: bootleg/);
 299                                         ++$loginsuccess if($loginsuccess == 3 && $line =~ /^Client \d+ disconnected/);
 300
 301                                         last if ($line =~ /ERROR/ or $line =~ /FATAL/);
 302                                 }
 303                         }
 304                         if (vec($rout, fileno(TASKMANAGER), 1))
 305                         {
 306                                 $line = unbufferReadline(\*TASKMANAGER);
 307                                 if(defined $line)
 308                                 {
 309                                         writelog("TaskManager: $line") if($line =~ /\S+/);
 310                                         ++$tasksuccess if($tasksuccess == 0 && $line =~ /^connection opened for service on port \d+/);
 311                                         ++$tasksuccess if($tasksuccess == 1 && $line =~ /^Opened connection with client/);
 312                                         ++$tasksuccess if($tasksuccess == 2 && $line =~ /^Recieved ClientIdMsg/);
 313                                         ++$tasksuccess if($tasksuccess == 3 && $line =~ /^Decrypting with key: /);
 314                                         ++$tasksuccess if($tasksuccess == 4 && $line =~ /^succeeded/);
 315                                         ++$tasksuccess if($tasksuccess == 5 && $line =~ /^ValidateAccountMessage/);
 316                                         ++$tasksuccess if($tasksuccess == 6 && $line =~ /^ValidateAccountReplyMessage/);
 317                                         ++$tasksuccess if($tasksuccess == 7 && $line =~ /^Permissions for \d+:/);
 318                                         ++$tasksuccess if($tasksuccess == 8 && $line =~ /canLogin/);
 319                                         ++$tasksuccess if($tasksuccess == 9 && $line =~ /canCreateRegularCharacter/);
 320                                         ++$tasksuccess if($tasksuccess == 10 && $line =~  /^Recvd SelectCharacter message for \d+/);
 321                                         ++$tasksuccess if($tasksuccess == 11 && $line =~  /^Got ValidateCharacterForLoginMessage acct \d+, character \d+/);
 322                                         ++$tasksuccess if($tasksuccess == 12 && $line =~  /^Pending character \d+ is logging in or dropping/);
 323
 324                                         last if ($line =~ /ERROR/ or $line =~ /FATAL/);
 325                                 }
 326                         }
 327                 }
 328
 329                 return 0 if((time - $starttime) > $waittime);
 330                 last if($loginsuccess == 4 && $tasksuccess == 13);
 331         }
 332
 333         writelog("LoginServer success: $loginsuccess/4, Taskmanager success: $tasksuccess/13");
 334         return 0 if($loginsuccess != 4 || $tasksuccess != 13);
 335
 336         # Tell win32 machine that the client is ok (don't need to kill it)
 337         print SOCKET CLIENT_OK;
 338
 339         read(SOCKET, $buffer, 1) == 1 or fatal "Error reading from win32 machine\n";
 340
 341         my $clientsuccess = 0;
 342         $clientsuccess = 1 if($buffer eq SUCCESSFUL_TEST);
 343
 344         writelog("Client success: $clientsuccess/1");
 345         return 0 if($clientsuccess != 1);
 346
 347         return 1;
 348 }
 349
 350 sub testBootleg
 351 {
 352         print "Testing build...\n";
 353         writelog("Testing build");
 354         my $test = 0;
 355
 356         startServer();
 357         startClient();
 358
 359         $test = checkResponses();
 360
 361         endServer();
 362         endClient();
 363
 364         fatal "Test for build $newbootleg unsuccessful\n" if(!$test);
 365         print "Testing successful.\n\n";
 366         writelog("Test for build successful: $test");
 367         open(BLESS, ">$builddir/$branch/$newbootleg/blessed.txt");
 368         close(BLESS);
 369
 370         return 1;
 371 }
 372
 373 sub email
 374 {
 375         # If we don't know the old bootleg (from install), get it
 376         if($oldbootleg eq "")
 377         {
 378                 my @bootlegs;
 379
 380                 opendir DH, "$builddir/$branch" or fatal "Cannot open $builddir/$branch: $!\n";
 381                 foreach (readdir DH)
 382                 {
 383                         push @bootlegs, $_ if(/^\d+$/ && -d ("$builddir/$branch/$_"));
 384                 }
 385                 closedir DH;
 386
 387                 foreach (sort {$b <=> $a} @bootlegs)
 388                 {
 389                         if(-e "$builddir/$branch/$_/blessed.txt")
 390                         {
 391                                 # This is the first blessed bootleg
 392                                 $newbootleg = $_ if($newbootleg eq "");
 393
 394                                 # This is the second blessed bootleg
 395                                 $oldbootleg = $_ if($newbootleg ne $_);
 396                         }
 397                         last if($oldbootleg ne "");
 398                 }
 399         }
 400
 401         print "Emailing about changes from bootleg $oldbootleg to $newbootleg...\n";
 402         writelog("Emailing changes from $oldbootleg to $newbootleg");
 403         return 0 if($oldbootleg eq "");
 404         open(EMAIL, "| mail -s \"[bootleg] $branch.$newbootleg.0 is up\" $emailRecipients");
 405
 406         print EMAIL "${builddir}/\n".
 407             "\n-Vijay\n\n";
 408
 409         print EMAIL "Changes between $oldbootleg and $newbootleg\n";
 410
 411         open(CHANGES, "perl ${depotdir}/swg/current/tools/BuildChanges.pl -i //depot/swg/$branch/... $oldbootleg $newbootleg |");
 412         while(<CHANGES>)
 413         {
 414                 next if(/^Change (\d+) on/ || /^\[(public|internal)\]/ || /^\n/ || /.?none.?/i || /n(\/|\.)a/i || /^---/ || /ignoring script recompile/i);
 415                 s/^\s*-?\s*//;
 416                 print EMAIL "\t- $_";
 417         }
 418         close(CHANGES);
 419         print "Completed emailing.\n\n";
 420         writelog("Completed emailing.");
 421
 422         return 1;
 423 }
 424
 425 sub upkeep
 426 {
 427         my $removedbootlegs = 0;
 428
 429         print "Performing upkeep on bootleg directory for $branch...\n";
 430         writelog("Performing upkeep on bootleg directory for $branch...");
 431
 432         my $controller = perforceWhere("//depot/swg/current/tools/build_cluster_controller.pl");
 433         my $buildcluster;
 434
 435         open(BUILD, "perl $controller -bootleg-version 2>&1 |");
 436         while(<BUILD>)
 437         {
 438                 $buildcluster = $1 if(/^Build cluster bootleg version is: (\d+)/);
 439         }
 440         close(BUILD);
 441
 442         return 0 if(!defined $buildcluster);
 443
 444         my @bootlegs;
 445         opendir DH, "$builddir/$branch" or fatal "Cannot open $builddir/$branch: $!\n";
 446         foreach (readdir DH)
 447         {
 448                 push @bootlegs, $_ if(/^\d+$/ && -d ("$builddir/$branch/$_"));
 449         }
 450         closedir DH;
 451
 452         @bootlegs = sort { $a <=> $b } @bootlegs;
 453
 454         while(@bootlegs > $numbootlegs)
 455         {
 456                 my $bootleg = shift @bootlegs;
 457                 next if($buildcluster == $bootleg);
 458
 459                 print STDERR "Removing bootleg $bootleg...\n";
 460                 writelog("Removing bootleg $bootleg...");
 461                 system("rm -fr $builddir/$branch/$branch/$bootleg");
 462                 ++$removedbootlegs;
 463         }
 464
 465         print STDERR "Completed upkeep on bootleg directory - removed $removedbootlegs bootlegs.\n";
 466         writelog("Completed upkeep on bootleg directory - removed $removedbootlegs bootlegs.");
 467
 468         return 1;
 469 }
 470
 471 # ======================================================================
 472 # Main
 473 # ======================================================================
 474
 475 usage() if(!GetOptions('install' => \$steps[0], 'test' => \$steps[1], 'email' => \$steps[2], 'upkeep' => \$steps[3]));
 476 usage() if(@ARGV != 1);
 477
 478 # open the log file
 479 open(LOG, ">>$logfile");
 480 unbuffer(\*LOG);
 481
 482 $branch = shift;
 483 print "Beginning test for branch $branch\n";
 484 writelog("Beginning test for branch $branch");
 485
 486 installBootleg() || fatal "installBootleg" if($steps[0]);
 487 testBootleg() || fatal "testBootleg" if($steps[1]);
 488 email() || fatal "email" if($steps[2]);
 489 upkeep() || fatal "upkeep" if($steps[3]);
 490
 491 print "Test of $newbootleg complete.\n";
 492 writelog("test of $newbootleg complete");
 493
 494 close(LOG);