tools/test_build_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
  22 # ======================================================================
  23 # Globals
  24 # ======================================================================
  25
  26 my $scriptName = $0;
  27 $scriptName =~ s/^(.*)\\//;
  28
  29 my $branch;
  30 my $bootlegnum = "";
  31 my $waittime = "60";
  32 my $port = "98514";
  33
  34 # ======================================================================
  35 # Subroutines
  36 # ======================================================================
  37
  38 sub usage
  39 {
  40         die "\n\t$scriptName\n\n";
  41 }
  42
  43 sub perforceWhere
  44 {
  45         local $_;
  46
  47         # find out where a perforce file resides on the local machine
  48         my $result;
  49         {
  50                 open(P4, "p4 where $_[0] |");
  51                         $_ = <P4>;
  52                         chomp;
  53                         my @where = split;
  54                         $result = $where[2];
  55                 close(P4);
  56         }
  57
  58         return $result;
  59 }
  60
  61 sub reloop
  62 {
  63         print STDERR "Error with: $_[0]\n" if(defined $_[0]);
  64         print STDERR "Exiting this connection\n";
  65         goto FAIL;
  66 }
  67
  68 sub installBootleg
  69 {
  70         print "Installing bootleg...\n";
  71
  72         open(INSTALL, "perl " . perforceWhere("//depot/swg/current/tools/InstallBootleg.pl") . " --list --force_newest --client_only $branch |") or reloop "Error running InstallBootleg.pl\n";
  73
  74         my $complete = 0;
  75
  76         while(<INSTALL>)
  77         {
  78                 print;
  79                 $bootlegnum = $1 if(/^Updating to build: (\d+)/);
  80                 $complete = 1 if(/^Update complete/);
  81         }
  82
  83         close(INSTALL);
  84
  85         print "Bootleg installation incomplete\n" if(!$complete);
  86         print "Completed installing bootleg.\n" if($complete);
  87
  88         return $complete;
  89 }
  90
  91 sub error
  92 {
  93         my $message = shift @_;
  94         print SOCKET UNSUCCESSFUL_TEST;
  95         print STDERR "$message\n";
  96         goto FAIL;
  97 }
  98
  99 sub fatal
 100 {
 101         my $message = shift @_;
 102         print SOCKET UNSUCCESSFUL_TEST;
 103         close(SOCKET);
 104         die "$message\n";
 105 }
 106
 107 sub makeDir
 108 {
 109         my(@tok, $check);
 110         @tok = split(/\\|\//, $_[0]);
 111
 112         $check = shift(@tok);
 113         foreach (@tok)
 114         {
 115                 $check .= "/$_";
 116                 if(!(-d $check))
 117                 {
 118                         mkdir $check;
 119                 }
 120         }
 121
 122 }
 123
 124 sub testBootleg
 125 {
 126         my $buffer;
 127         print STDERR "Initializing communication...\n";
 128
 129         error("problem reading from socket") if (read(SOCKET, $buffer, 4) != 4);
 130         my $length = unpack("N", $buffer);
 131         error("problem reading from socket") if(read(SOCKET, $branch, $length) != $length);
 132
 133         print STDERR "Testing bootleg for branch: $branch\n";
 134
 135         my $bootlegdir = perforceWhere("//depot/swg/$branch/bootleg/win32/...");
 136         $bootlegdir =~ s/\.{3}//;
 137
 138         chdir($bootlegdir) or reloop "Cannot change to bootleg directory\n";
 139
 140         installBootleg() || fatal "Error installing bootleg";
 141
 142         print SOCKET pack("N", $bootlegnum);
 143
 144         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 145         error("mismatch in client / server bootlegs")if($buffer eq BOOTLEG_MISMATCH);
 146         error("server not ready") if ($buffer ne SERVER_READY);
 147         print STDERR "Bootleg $bootlegnum verified with server - running client...\n";
 148
 149         # Get the ip of the server machine
 150         my $other_socket = getpeername(SOCKET) || reloop "Couldn't identify other end: $!\n";
 151         my ($other_port, $other_ip) = unpack_sockaddr_in($other_socket);
 152         my $server_ip = inet_ntoa($other_ip);
 153
 154         my $killresult;
 155         my $swgpid = open(SWGCLIENT, "SwgClient_o.exe -- -s ClientGame loginServerAddress=$server_ip skipIntro=true skipSplash=true autoConnectToLoginServer=true loginClientID=bootleg loginClientPassword=bootleg avatarName=\"bootleg bootleg\" autoConnectToGameServer=true autoQuitAfterLoadScreen=true -s SharedFoundation demoMode=true |");
 156         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 157         if($buffer eq CLIENT_KILL)
 158         {
 159                 kill 1, $swgpid;
 160                 error("Test unsuccessful - forced to kill client");
 161         }
 162         elsif($buffer eq CLIENT_OK)
 163         {
 164                 # make sure we give the client a chance to exit on its own, then attempt to kill
 165                 print "Waiting for $waittime seconds for the client to end on its own...\n";
 166                 sleep($waittime);
 167                 $killresult = kill 1, $swgpid;
 168         }
 169         close(SWGCLIENT);
 170
 171         # clientResult = 1 if return value of SwgClient == 0 and we did not have to kill it ($killresult = 0)
 172         my $clientResult = (!($? >> 8) && !$killresult);
 173         print "clientresult=$clientResult killresult=$killresult exitresult=$?\n";
 174
 175         print SOCKET ($clientResult == 1) ? SUCCESSFUL_TEST : UNSUCCESSFUL_TEST;
 176
 177         print STDERR "Test was " . (($clientResult == 1) ? "successful\n" : "unsuccessful\n") . "\n";
 178 }
 179
 180 # ======================================================================
 181 # Main
 182 # ======================================================================
 183
 184 # open the daemon socket
 185 print STDERR "Opening socket\n";
 186 socket(LISTEN, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket failed\n";
 187 setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, 1) || die "setsockopt failed\n";
 188 my $addr = sockaddr_in($port, INADDR_ANY);
 189 bind(LISTEN, $addr) || die "bind failed\n";
 190 listen(LISTEN, 1) || die "listen failed\n";
 191
 192 BUILDLOOP:
 193 while (1)
 194 {
 195         print STDERR "Waiting on a connection...\n";
 196
 197         accept(SOCKET, LISTEN) || reloop "accept failed\n";
 198
 199         # make binary and unbuffer the socket
 200         binmode(SOCKET);
 201         my $oldSelect = select(SOCKET);
 202         $| = 1;
 203         select($oldSelect);
 204
 205         my $buffer;
 206         error("problem reading from socket") if (read(SOCKET, $buffer, 1) != 1);
 207
 208         if($buffer eq START_BOOTLEG_TEST)
 209         {
 210                 print "Got message to initiate bootleg test.\n";
 211                 testBootleg();
 212         }
 213 FAIL:
 214         close(SOCKET);
 215 }