mirror of
https://bitbucket.org/theswgsource/client-tools-1.2.git
synced 2026-01-16 23:04:40 -05:00
495 lines
13 KiB
Perl
495 lines
13 KiB
Perl
#! /usr/bin/perl
|
|
# ======================================================================
|
|
# ======================================================================
|
|
|
|
use warnings;
|
|
use strict;
|
|
use Socket;
|
|
use Getopt::Long;
|
|
use File::Copy;
|
|
|
|
# ======================================================================
|
|
# Constants
|
|
# ======================================================================
|
|
|
|
use constant START_BOOTLEG_TEST => "A";
|
|
use constant END_COMMUNICATION => "B";
|
|
use constant SUCCESSFUL_TEST => "C";
|
|
use constant UNSUCCESSFUL_TEST => "D";
|
|
use constant SERVER_READY => "E";
|
|
use constant BOOTLEG_MISMATCH => "F";
|
|
use constant CLIENT_KILL => "G";
|
|
use constant CLIENT_OK => "H";
|
|
|
|
# ======================================================================
|
|
# Globals
|
|
# ======================================================================
|
|
|
|
my $scriptName = $0;
|
|
$scriptName =~ s/^(.*)\\//;
|
|
|
|
my $depotdir = "/swg";
|
|
my $builddir = "/mnt/misc/builds";
|
|
my $logfile = "test_build.log";
|
|
my $win32machine = "64.37.133.173";
|
|
my $port = "98514";
|
|
my $emailRecipients = "vthakkar\@soe.sony.com";
|
|
|
|
my $waittime = "180";
|
|
my $branch = "";
|
|
my $oldbootleg = "";
|
|
my $newbootleg = "";
|
|
my $loginpid;
|
|
my $taskpid;
|
|
|
|
my $numbootlegs = 7;
|
|
|
|
my @steps = (0, 0, 0, 0);
|
|
|
|
# ======================================================================
|
|
# Subroutines
|
|
# ======================================================================
|
|
|
|
sub usage
|
|
{
|
|
print "\n\t$scriptName <optional parameters> <branch>\n\n".
|
|
"\tOptional parameters:\n\n".
|
|
"\t\t--install\t: Install newest build\n".
|
|
"\t\t--test\t\t: Test build\n".
|
|
"\t\t--email\t\t: Send email about results\n".
|
|
"\t\t--upkeep\t: Perform upkeep on bootleg directories\n";
|
|
die "\n";
|
|
}
|
|
|
|
sub writelog
|
|
{
|
|
my $message = shift @_;
|
|
chomp $message;
|
|
my ($sec, $min, $hr, $day, $mon, $yr) = localtime time;
|
|
my $timestamp = sprintf "%4s-%02s-%02s\t%02s:%02s:%02s", ($yr + 1900), ($mon + 1), $day, $hr, $min, $sec;
|
|
|
|
print LOG join("\t", $timestamp, $message), "\n";
|
|
}
|
|
|
|
sub fatal
|
|
{
|
|
my $message = shift @_;
|
|
print "Fatal error running: $message\n";
|
|
writelog("Fatal error running: $message");
|
|
close(LOG);
|
|
die;
|
|
}
|
|
|
|
sub unbuffer
|
|
{
|
|
my $oldSelect = select($_[0]);
|
|
$| = 1;
|
|
select($oldSelect);
|
|
}
|
|
|
|
sub unbufferReadline
|
|
{
|
|
my ($fh) = @_;
|
|
my $buffer;
|
|
my $return = "";
|
|
while(sysread($fh, $buffer, 1))
|
|
{
|
|
$return .= $buffer;
|
|
last if($buffer eq "\n");
|
|
}
|
|
return $return;
|
|
}
|
|
|
|
sub perforceWhere
|
|
{
|
|
local $_;
|
|
|
|
# find out where a perforce file resides on the local machine
|
|
my $result;
|
|
{
|
|
open(P4, "p4 where $_[0] |");
|
|
$_ = <P4>;
|
|
chomp;
|
|
my @where = split;
|
|
$result = $where[2];
|
|
close(P4);
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
|
|
sub openClientSocket
|
|
{
|
|
socket(SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || closeServer("socket failed\n");
|
|
{
|
|
my $destination = inet_aton($win32machine) || closeServer("inet_aton failed\n");
|
|
my $paddr = sockaddr_in($port, $destination);
|
|
connect(SOCKET, $paddr) || closeServer("connect failed\n");
|
|
|
|
# unbuffer the socket
|
|
my $oldSelect = select(SOCKET);
|
|
$| = 1;
|
|
select($oldSelect);
|
|
|
|
# put the socket into binary mode
|
|
binmode SOCKET;
|
|
}
|
|
}
|
|
|
|
sub getCurrentBootleg
|
|
{
|
|
my $bootleg = 0;
|
|
|
|
open(VER, perforceWhere("//depot/swg/$branch/tools/VersionNumber") . " -r ".perforceWhere("//depot/swg/$branch/bootleg/linux/debug/lib/libsharedFoundataion.so")." |");
|
|
while(<VER>)
|
|
{
|
|
$bootleg = $1 if(/\s(\d+)\.0 bootleg/);
|
|
}
|
|
close(VER);
|
|
|
|
return $bootleg;
|
|
}
|
|
|
|
|
|
sub installBootleg
|
|
{
|
|
print "Installing bootleg...\n";
|
|
writelog("Installing bootleg");
|
|
|
|
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";
|
|
|
|
my $complete = 0;
|
|
|
|
while(<INSTALL>)
|
|
{
|
|
print;
|
|
writelog($_);
|
|
$complete = 1 if(/^Update complete\./);
|
|
$oldbootleg = $1 if($oldbootleg eq "" && /^\d+\s+(\d+)\s+blessed/);
|
|
$newbootleg = $1 if(/^Updating to build: (\d+)/);
|
|
}
|
|
|
|
close(INSTALL);
|
|
|
|
print "Bootleg installation incomplete\n" if(!$complete);
|
|
print "Completed installing bootleg.\n\n" if($complete);
|
|
writelog("OldBootleg: $oldbootleg, InstallBootleg complete: $complete");
|
|
|
|
return $complete;
|
|
}
|
|
|
|
sub closeServer
|
|
{
|
|
print "Fatal Error: Killing forked processes\n";
|
|
endServer();
|
|
fatal $_[0];
|
|
}
|
|
|
|
sub startServer
|
|
{
|
|
my $loginServer = "debug/LoginServer";
|
|
my $taskManager = "debug/TaskManager";
|
|
|
|
writelog("Starting Server");
|
|
my $serverdir = perforceWhere("//depot/swg/$branch/bootleg/linux/fakefile");
|
|
$serverdir =~ s/fakefile$//;
|
|
chdir($serverdir) || fatal "Cannot change directory to $serverdir\n";
|
|
|
|
print "Starting up server...\n";
|
|
$loginpid = open(LOGINSERVER, "$loginServer -- \@loginServer.cfg 2>&1 |") or closeServer("Can't open LoginServer\n");
|
|
binmode LOGINSERVER;
|
|
|
|
while(<LOGINSERVER>)
|
|
{
|
|
writelog("LoginServer: $_") if(/\S+/);
|
|
last if(/^Cluster \d+:/);
|
|
}
|
|
|
|
$taskpid = open(TASKMANAGER, "$taskManager -- \@taskmanager.cfg 2>&1 |") or closeServer("Can't open TaskManager\n");
|
|
binmode TASKMANAGER;
|
|
|
|
while(<TASKMANAGER>)
|
|
{
|
|
writelog("TaskManager: $_") if(/\S+/);
|
|
last if(/^Preload finished on all planets/);
|
|
}
|
|
}
|
|
|
|
sub endServer
|
|
{
|
|
writelog("Ending Server");
|
|
print "Shutting down server.\n";
|
|
kill 1, $taskpid if(defined $taskpid);
|
|
kill 1, $loginpid if(defined $loginpid);
|
|
system("killall CommoditiesServer");
|
|
system("killall ChatServer");
|
|
close(TASKMANAGER);
|
|
close(LOGINSERVER);
|
|
}
|
|
|
|
sub startClient
|
|
{
|
|
writelog("Starting Client");
|
|
print "Starting up client...\n";
|
|
|
|
openClientSocket();
|
|
|
|
print SOCKET START_BOOTLEG_TEST;
|
|
print SOCKET pack("N", length $branch);
|
|
print SOCKET $branch;
|
|
}
|
|
|
|
sub endClient
|
|
{
|
|
writelog("Ending Client");
|
|
print SOCKET CLIENT_KILL;
|
|
print "Shutting down client.\n";
|
|
close(SOCKET);
|
|
}
|
|
|
|
sub checkResponses
|
|
{
|
|
writelog("Verifying server and client responses");
|
|
my $loginsuccess = 0;
|
|
my $tasksuccess = 0;
|
|
my $buffer;
|
|
|
|
print "Verifying client and server have same bootleg installation.\n";
|
|
read(SOCKET, $buffer, 4) == 4 or fatal "Error reading from win32 machine\n";
|
|
my $clientbootleg = unpack("N", $buffer);
|
|
|
|
$newbootleg = getCurrentBootleg() if(!defined $newbootleg);
|
|
|
|
if($clientbootleg ne $newbootleg)
|
|
{
|
|
writelog("Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg");
|
|
print "Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg\n";
|
|
print SOCKET BOOTLEG_MISMATCH;
|
|
return 0;
|
|
}
|
|
print "Both client and server have bootleg $newbootleg installed\n";
|
|
writelog("Both client and server have bootleg $newbootleg installed");
|
|
|
|
print SOCKET SERVER_READY;
|
|
|
|
my $starttime = time;
|
|
writelog("Beginning test with client - timeout of $waittime seconds");
|
|
|
|
# used to create non-blocking reading of both filehandles
|
|
while(1)
|
|
{
|
|
my $rin = '';
|
|
my $rout;
|
|
my $line;
|
|
vec($rin, fileno(LOGINSERVER), 1) = 1;
|
|
vec($rin, fileno(TASKMANAGER), 1) = 1;
|
|
|
|
if(select($rout=$rin, undef, undef, 0))
|
|
{
|
|
if (vec($rout, fileno(LOGINSERVER), 1))
|
|
{
|
|
$line = unbufferReadline(\*LOGINSERVER);
|
|
if(defined $line)
|
|
{
|
|
writelog("LoginServer: $line") if($line =~ /\S+/);
|
|
++$loginsuccess if($loginsuccess == 0 && $line =~ /^connection opened for service on port \d+/);
|
|
++$loginsuccess if($loginsuccess == 1 && $line =~ /^Encrypting with key:/);
|
|
++$loginsuccess if($loginsuccess == 2 && $line =~ /^Client connected\. Station Id: \d+, Username: bootleg/);
|
|
++$loginsuccess if($loginsuccess == 3 && $line =~ /^Client \d+ disconnected/);
|
|
|
|
last if ($line =~ /ERROR/ or $line =~ /FATAL/);
|
|
}
|
|
}
|
|
if (vec($rout, fileno(TASKMANAGER), 1))
|
|
{
|
|
$line = unbufferReadline(\*TASKMANAGER);
|
|
if(defined $line)
|
|
{
|
|
writelog("TaskManager: $line") if($line =~ /\S+/);
|
|
++$tasksuccess if($tasksuccess == 0 && $line =~ /^connection opened for service on port \d+/);
|
|
++$tasksuccess if($tasksuccess == 1 && $line =~ /^Opened connection with client/);
|
|
++$tasksuccess if($tasksuccess == 2 && $line =~ /^Recieved ClientIdMsg/);
|
|
++$tasksuccess if($tasksuccess == 3 && $line =~ /^Decrypting with key: /);
|
|
++$tasksuccess if($tasksuccess == 4 && $line =~ /^succeeded/);
|
|
++$tasksuccess if($tasksuccess == 5 && $line =~ /^ValidateAccountMessage/);
|
|
++$tasksuccess if($tasksuccess == 6 && $line =~ /^ValidateAccountReplyMessage/);
|
|
++$tasksuccess if($tasksuccess == 7 && $line =~ /^Permissions for \d+:/);
|
|
++$tasksuccess if($tasksuccess == 8 && $line =~ /canLogin/);
|
|
++$tasksuccess if($tasksuccess == 9 && $line =~ /canCreateRegularCharacter/);
|
|
++$tasksuccess if($tasksuccess == 10 && $line =~ /^Recvd SelectCharacter message for \d+/);
|
|
++$tasksuccess if($tasksuccess == 11 && $line =~ /^Got ValidateCharacterForLoginMessage acct \d+, character \d+/);
|
|
++$tasksuccess if($tasksuccess == 12 && $line =~ /^Pending character \d+ is logging in or dropping/);
|
|
|
|
last if ($line =~ /ERROR/ or $line =~ /FATAL/);
|
|
}
|
|
}
|
|
}
|
|
|
|
return 0 if((time - $starttime) > $waittime);
|
|
last if($loginsuccess == 4 && $tasksuccess == 13);
|
|
}
|
|
|
|
writelog("LoginServer success: $loginsuccess/4, Taskmanager success: $tasksuccess/13");
|
|
return 0 if($loginsuccess != 4 || $tasksuccess != 13);
|
|
|
|
# Tell win32 machine that the client is ok (don't need to kill it)
|
|
print SOCKET CLIENT_OK;
|
|
|
|
read(SOCKET, $buffer, 1) == 1 or fatal "Error reading from win32 machine\n";
|
|
|
|
my $clientsuccess = 0;
|
|
$clientsuccess = 1 if($buffer eq SUCCESSFUL_TEST);
|
|
|
|
writelog("Client success: $clientsuccess/1");
|
|
return 0 if($clientsuccess != 1);
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub testBootleg
|
|
{
|
|
print "Testing build...\n";
|
|
writelog("Testing build");
|
|
my $test = 0;
|
|
|
|
startServer();
|
|
startClient();
|
|
|
|
$test = checkResponses();
|
|
|
|
endServer();
|
|
endClient();
|
|
|
|
fatal "Test for build $newbootleg unsuccessful\n" if(!$test);
|
|
print "Testing successful.\n\n";
|
|
writelog("Test for build successful: $test");
|
|
open(BLESS, ">$builddir/$branch/$newbootleg/blessed.txt");
|
|
close(BLESS);
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub email
|
|
{
|
|
# If we don't know the old bootleg (from install), get it
|
|
if($oldbootleg eq "")
|
|
{
|
|
my @bootlegs;
|
|
|
|
opendir DH, "$builddir/$branch" or fatal "Cannot open $builddir/$branch: $!\n";
|
|
foreach (readdir DH)
|
|
{
|
|
push @bootlegs, $_ if(/^\d+$/ && -d ("$builddir/$branch/$_"));
|
|
}
|
|
closedir DH;
|
|
|
|
foreach (sort {$b <=> $a} @bootlegs)
|
|
{
|
|
if(-e "$builddir/$branch/$_/blessed.txt")
|
|
{
|
|
# This is the first blessed bootleg
|
|
$newbootleg = $_ if($newbootleg eq "");
|
|
|
|
# This is the second blessed bootleg
|
|
$oldbootleg = $_ if($newbootleg ne $_);
|
|
}
|
|
last if($oldbootleg ne "");
|
|
}
|
|
}
|
|
|
|
print "Emailing about changes from bootleg $oldbootleg to $newbootleg...\n";
|
|
writelog("Emailing changes from $oldbootleg to $newbootleg");
|
|
return 0 if($oldbootleg eq "");
|
|
open(EMAIL, "| mail -s \"[bootleg] $branch.$newbootleg.0 is up\" $emailRecipients");
|
|
|
|
print EMAIL "${builddir}/\n".
|
|
"\n-Vijay\n\n";
|
|
|
|
print EMAIL "Changes between $oldbootleg and $newbootleg\n";
|
|
|
|
open(CHANGES, "perl ${depotdir}/swg/current/tools/BuildChanges.pl -i //depot/swg/$branch/... $oldbootleg $newbootleg |");
|
|
while(<CHANGES>)
|
|
{
|
|
next if(/^Change (\d+) on/ || /^\[(public|internal)\]/ || /^\n/ || /.?none.?/i || /n(\/|\.)a/i || /^---/ || /ignoring script recompile/i);
|
|
s/^\s*-?\s*//;
|
|
print EMAIL "\t- $_";
|
|
}
|
|
close(CHANGES);
|
|
print "Completed emailing.\n\n";
|
|
writelog("Completed emailing.");
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub upkeep
|
|
{
|
|
my $removedbootlegs = 0;
|
|
|
|
print "Performing upkeep on bootleg directory for $branch...\n";
|
|
writelog("Performing upkeep on bootleg directory for $branch...");
|
|
|
|
my $controller = perforceWhere("//depot/swg/current/tools/build_cluster_controller.pl");
|
|
my $buildcluster;
|
|
|
|
open(BUILD, "perl $controller -bootleg-version 2>&1 |");
|
|
while(<BUILD>)
|
|
{
|
|
$buildcluster = $1 if(/^Build cluster bootleg version is: (\d+)/);
|
|
}
|
|
close(BUILD);
|
|
|
|
return 0 if(!defined $buildcluster);
|
|
|
|
my @bootlegs;
|
|
opendir DH, "$builddir/$branch" or fatal "Cannot open $builddir/$branch: $!\n";
|
|
foreach (readdir DH)
|
|
{
|
|
push @bootlegs, $_ if(/^\d+$/ && -d ("$builddir/$branch/$_"));
|
|
}
|
|
closedir DH;
|
|
|
|
@bootlegs = sort { $a <=> $b } @bootlegs;
|
|
|
|
while(@bootlegs > $numbootlegs)
|
|
{
|
|
my $bootleg = shift @bootlegs;
|
|
next if($buildcluster == $bootleg);
|
|
|
|
print STDERR "Removing bootleg $bootleg...\n";
|
|
writelog("Removing bootleg $bootleg...");
|
|
system("rm -fr $builddir/$branch/$branch/$bootleg");
|
|
++$removedbootlegs;
|
|
}
|
|
|
|
print STDERR "Completed upkeep on bootleg directory - removed $removedbootlegs bootlegs.\n";
|
|
writelog("Completed upkeep on bootleg directory - removed $removedbootlegs bootlegs.");
|
|
|
|
return 1;
|
|
}
|
|
|
|
# ======================================================================
|
|
# Main
|
|
# ======================================================================
|
|
|
|
usage() if(!GetOptions('install' => \$steps[0], 'test' => \$steps[1], 'email' => \$steps[2], 'upkeep' => \$steps[3]));
|
|
usage() if(@ARGV != 1);
|
|
|
|
# open the log file
|
|
open(LOG, ">>$logfile");
|
|
unbuffer(\*LOG);
|
|
|
|
$branch = shift;
|
|
print "Beginning test for branch $branch\n";
|
|
writelog("Beginning test for branch $branch");
|
|
|
|
installBootleg() || fatal "installBootleg" if($steps[0]);
|
|
testBootleg() || fatal "testBootleg" if($steps[1]);
|
|
email() || fatal "email" if($steps[2]);
|
|
upkeep() || fatal "upkeep" if($steps[3]);
|
|
|
|
print "Test of $newbootleg complete.\n";
|
|
writelog("test of $newbootleg complete");
|
|
|
|
close(LOG);
|