Merged in Governor-Tarkin/swg-src (pull request #17)
[swg-src.git] / tools / build_bootleg_linux.pl
blob0b8e81ec7ba6be78e915ecf1e7aa12978b1a0637
1 #! /usr/bin/perl
2 # ======================================================================
3 # ======================================================================
5 use warnings;
6 use strict;
7 use Socket;
8 use Getopt::Long;
9 use File::Copy;
11 # ======================================================================
12 # Constants
13 # ======================================================================
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 use constant GOT_BUILD_CLUSTER_VERSION => "I";
24 use constant FAILED_GETTING_BUILD_CLUSTER_VERSION => "J";
25 use constant START_UPKEEP => "K";
26 use constant START_BOOTLEG_SEND => "L";
27 use constant BOOTLEG_SEND_DIRECTORY => "M";
28 use constant BOOTLEG_SEND_FILE => "N";
29 use constant END_BOOTLEG_SEND => "O";
30 use constant START_EMAIL => "P";
32 # ======================================================================
33 # Globals
34 # ======================================================================
36 my $name = $0;
37 $name =~ s/^(.*)\\//;
39 my $depotdir = "/swg";
40 my $bootlegdir = "/swg/bootlegs";
41 my $logfile = "build_bootleg.log";
42 my $win32machine = "64.37.133.173";
43 my $port = "21498";
44 my $emailRecipients = "vthakkar\@soe.sony.com";
46 my $waittime = "180";
47 my $branch = "";
48 my $oldbootleg = "";
49 my $newbootleg = "";
50 my $loginpid;
51 my $taskpid;
53 my @steps = (0, 0, 0, 0, 0, 0, 0, 0);
55 # ======================================================================
56 # Subroutines
57 # ======================================================================
59 sub usage
61 print "\n\t$name <optional parameters> <branch>\n\n".
62 "\tOptional parameters:\n\n".
63 "\t\t--no_script\t: Don't do a script recompile\n".
64 "\t\t--no_build\t: Don't build a new bootleg\n".
65 "\t\t--no_patch\t: Don't create a patchtree file\n".
66 "\t\t--no_send\t: Don't send build / patch results to win32 machine\n".
67 "\t\t--no_install\t: Don't install newest bootleg\n".
68 "\t\t--no_test\t: Don't perform test on bootleg\n".
69 "\t\t--no_email\t: Don't send email about results\n".
70 "\t\t--no_upkeep\t: Don't perform upkeep on bootleg directories\n".
71 "\n\tWarning: Some options depend on others, some combinations may not work.\n";
72 die "\n";
76 sub writelog
78 my $message = shift @_;
79 chomp $message;
80 my ($sec, $min, $hr, $day, $mon, $yr) = localtime time;
81 my $timestamp = sprintf "%4s-%02s-%02s\t%02s:%02s:%02s", ($yr + 1900), ($mon + 1), $day, $hr, $min, $sec;
83 print LOG join("\t", $timestamp, $message), "\n";
86 sub fatal
88 my $message = shift @_;
89 print "Fatal error running: $message\n";
90 writelog("Fatal error running: $message");
91 close(LOG);
92 die;
95 sub unbuffer
97 my $oldSelect = select($_[0]);
98 $| = 1;
99 select($oldSelect);
102 sub unbufferReadline
104 my ($fh) = @_;
105 my $buffer;
106 my $return = "";
107 while(sysread($fh, $buffer, 1))
109 $return .= $buffer;
110 last if($buffer eq "\n");
112 return $return;
115 sub perforceWhere
117 local $_;
119 # find out where a perforce file resides on the local machine
120 my $result;
122 open(P4, "p4 where $_[0] |");
123 $_ = <P4>;
124 chomp;
125 my @where = split;
126 $result = $where[2];
127 close(P4);
130 return $result;
134 sub openClientSocket
136 socket(SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || closeServer("socket failed\n");
138 my $destination = inet_aton($win32machine) || closeServer("inet_aton failed\n");
139 my $paddr = sockaddr_in($port, $destination);
140 connect(SOCKET, $paddr) || closeServer("connect failed\n");
142 # unbuffer the socket
143 my $oldSelect = select(SOCKET);
144 $| = 1;
145 select($oldSelect);
147 # put the socket into binary mode
148 binmode SOCKET;
152 sub buildBootleg
154 my $win32complete = 0;
155 my $linuxcomplete = 0;
157 print "Building bootleg...\n";
158 writelog("Building bootleg");
159 open(LINUXBUILD, "perl ${depotdir}/swg/current/tools/build_script_linux_new.pl $branch -bootleg -incrediBuild 2>&1 |") or fatal "Error running build_script_linux.pl\n";
161 while(<LINUXBUILD>)
163 print;
164 writelog($_);
165 $newbootleg = $1 if(/^Syncing to $branch\@(\d+)/);
166 $win32complete = 1 if(/^Windows build returned 0/);
167 $linuxcomplete = 1 if(/^Linux build returned 0/);
170 close(LINUXBUILD);
172 print "linux build incomplete\n" if(!$linuxcomplete);
173 print "windows build incomplete\n" if(!$win32complete);
174 print "Completed building bootleg $newbootleg.\n\n" if($win32complete && $linuxcomplete);
176 writelog("Bootleg: $newbootleg, Linux complete: $linuxcomplete, Windows complete: $win32complete");
177 ($win32complete && $linuxcomplete) ? return 1 : return 0;
180 sub buildPatchTree
182 my $patch_tree_complete = 0;
183 my $patch_changelist = 0;
185 print "Building patch tree...\n";
186 writelog("Building patch tree");
187 mkdir "$bootlegdir/$branch/$newbootleg/patch" || fatal "mkdir for patchtree failed";
189 open(PATCHTREE, "perl ${depotdir}/swg/current/tools/CheckPatchTreeSize.pl --sync --changelist=$newbootleg --save_treefile=$bootlegdir/$branch/$newbootleg/patch/bootlegpatch.tre |") or fatal "Error running CheckPatchTreeSize.pl\n";
190 while(<PATCHTREE>)
192 print;
193 writelog($_);
194 $patch_changelist = $1 if(/^Most recent final manifest at revision \d+, patch \d+, changelist (\d+)/);
195 $patch_tree_complete = 1 if(/^Size of \.tre is: \d+$/);
197 close(PATCHTREE);
199 move "$bootlegdir/$branch/$newbootleg/patch/bootlegpatch.tre", "$bootlegdir/$branch/$newbootleg/patch/bootleg_${patch_changelist}_${newbootleg}.tre";
201 print "Patch tree build incomplete.\n\n" if(!$patch_tree_complete);
202 print "Patch tree build complete.\n\n" if($patch_tree_complete);
204 writelog("Patch Tree complete: $patch_tree_complete");
205 return $patch_tree_complete;
208 sub sendBootleg
210 print "Sending bootleg / patch to win32 machine...\n";
211 writelog("Sending bootleg / patch to win32 machine...");
213 openClientSocket();
215 print SOCKET START_BOOTLEG_SEND;
216 print SOCKET pack("N", length $branch);
217 print SOCKET $branch;
218 print SOCKET pack("N", $newbootleg);
220 # Build an array of what directories to send over
221 my @directories;
222 push @directories, "patch" if(-d "$bootlegdir/$branch/$newbootleg/patch");
223 push @directories, "servers" if(-d "$bootlegdir/$branch/$newbootleg/servers");
225 while(@directories = sort @directories)
227 my $dir = shift @directories;
229 # Tell the windows machine to get a new directory
230 print SOCKET BOOTLEG_SEND_DIRECTORY;
231 print SOCKET pack("N", length $dir);
232 print SOCKET $dir;
234 opendir DH, "$bootlegdir/$branch/$newbootleg/$dir" || die "could not open directory\n";
235 foreach my $fileName (sort readdir DH)
237 next if($fileName eq "." || $fileName eq "..");
238 push @directories, "$dir/$fileName" if(-d "$bootlegdir/$branch/$newbootleg/$dir/$fileName");
239 next if(!-f "$bootlegdir/$branch/$newbootleg/$dir/$fileName");
241 my $fileSize = -s "$bootlegdir/$branch/$newbootleg/$dir/$fileName";
242 print "Sending file $fileName ($fileSize bytes)\n";
243 writelog("Sending file $fileName ($fileSize bytes)");
244 print SOCKET BOOTLEG_SEND_FILE;
245 print SOCKET pack("NN", length $fileName, $fileSize);
246 print SOCKET $fileName;
247 open(F, "<$bootlegdir/$branch/$newbootleg/$dir/$fileName");
248 binmode(F);
249 while ($fileSize)
251 my $buffer;
252 my $readSize = 16 * 1024;
253 $readSize = $fileSize if ($fileSize < $readSize);
254 my $readResult = read(F, $buffer, $readSize);
255 die "unexpected end of file" if (!defined($readResult));
256 die "did not read what we expected to" if ($readResult != $readSize);
257 print SOCKET $buffer;
258 $fileSize -= $readResult;
260 die "copied all the bytes but not at EOF" if (!eof(F));
261 close(F);
263 closedir DH;
266 print SOCKET END_BOOTLEG_SEND;
267 print "Finished sending to win32 machine.\n";
268 writelog("Finished sending to win32 machine.");
269 close(SOCKET);
271 return 1;
274 sub installBootleg
276 print "Installing bootleg...\n";
277 writelog("Installing bootleg");
279 open(INSTALL, "perl " . perforceWhere("//depot/swg/current/tools/InstallBootleg.pl") . " --list --force_newest --server_only --install_as_build_cluster $branch |") or fatal "Error running InstallBootleg.pl\n";
281 my $complete = 0;
283 while(<INSTALL>)
285 print;
286 writelog($_);
287 $complete = 1 if(/^Update complete\./);
288 $oldbootleg = $1 if($oldbootleg eq "" && /^\d+\s+(\d+)\s+blessed/);
289 $newbootleg = $1 if(/^Updating to build: (\d+)/);
292 close(INSTALL);
294 print "Bootleg installation incomplete\n" if(!$complete);
295 print "Completed installing bootleg.\n\n" if($complete);
296 writelog("OldBootleg: $oldbootleg, InstallBootleg complete: $complete");
298 return $complete;
301 sub closeServer
303 print "Fatal Error: Killing forked processes\n";
304 endServer();
305 fatal $_[0];
308 sub startServer
310 my $loginServer = "debug/LoginServer";
311 my $taskManager = "debug/TaskManager";
313 writelog("Starting Server");
314 my $serverdir = perforceWhere("//depot/swg/$branch/bootleg/linux/fakefile");
315 $serverdir =~ s/fakefile$//;
316 chdir($serverdir) || fatal "Cannot change directory to $serverdir\n";
318 print "Starting up server...\n";
319 $loginpid = open(LOGINSERVER, "$loginServer -- \@loginServer.cfg 2>&1 |") or closeServer("Can't open LoginServer\n");
320 binmode LOGINSERVER;
322 while(<LOGINSERVER>)
324 writelog("LoginServer: $_") if(/\S+/);
325 last if(/^Log observer setup/);
328 $taskpid = open(TASKMANAGER, "$taskManager -- \@taskmanager.cfg 2>&1 |") or closeServer("Can't open TaskManager\n");
329 binmode TASKMANAGER;
331 while(<TASKMANAGER>)
333 writelog("TaskManager: $_") if(/\S+/);
334 last if(/^Preload finished on all planets/);
338 sub endServer
340 writelog("Ending Server");
341 print "Shutting down server.\n";
342 kill 1, $taskpid if(defined $taskpid);
343 kill 1, $loginpid if(defined $loginpid);
344 system("killall CommoditiesServer");
345 system("killall ChatServer");
346 close(TASKMANAGER);
347 close(LOGINSERVER);
350 sub startClient
352 writelog("Starting Client");
353 print "Starting up client...\n";
355 openClientSocket();
357 print SOCKET START_BOOTLEG_TEST;
358 print SOCKET pack("N", length $branch);
359 print SOCKET $branch;
362 sub endClient
364 writelog("Ending Client");
365 print SOCKET CLIENT_KILL;
366 print "Shutting down client.\n";
367 close(SOCKET);
370 sub checkResponses
372 writelog("Verifying server and client responses");
373 my $loginsuccess = 0;
374 my $tasksuccess = 0;
375 my $buffer;
377 print "Verifying client and server have same bootleg installation.\n";
378 read(SOCKET, $buffer, 4) == 4 or fatal "Error reading from win32 machine\n";
379 my $clientbootleg = unpack("N", $buffer);
381 if($clientbootleg ne $newbootleg)
383 writelog("Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg");
384 print "Mismatch in client / server bootlegs - client: $clientbootleg, server: $newbootleg\n";
385 print SOCKET BOOTLEG_MISMATCH;
386 return 0;
388 print "Both client and server have bootleg $newbootleg installed\n";
389 writelog("Both client and server have bootleg $newbootleg installed");
391 print SOCKET SERVER_READY;
393 my $starttime = time;
394 writelog("Beginning test with client - timeout of $waittime seconds");
396 # used to create non-blocking reading of both filehandles
397 while(1)
399 my $rin = '';
400 my $rout;
401 my $line;
402 vec($rin, fileno(LOGINSERVER), 1) = 1;
403 vec($rin, fileno(TASKMANAGER), 1) = 1;
405 if(select($rout=$rin, undef, undef, 0))
407 if (vec($rout, fileno(LOGINSERVER), 1))
409 $line = unbufferReadline(\*LOGINSERVER);
410 if(defined $line)
412 writelog("LoginServer: $line") if($line =~ /\S+/);
413 ++$loginsuccess if($loginsuccess == 0 && $line =~ /^connection opened for service on port \d+/);
414 ++$loginsuccess if($loginsuccess == 1 && $line =~ /^Encrypting with key:/);
415 ++$loginsuccess if($loginsuccess == 2 && $line =~ /^Client connected\. Station Id: \d+, Username: bootleg/);
416 ++$loginsuccess if($loginsuccess == 3 && $line =~ /^Client \d+ disconnected/);
418 last if ($line =~ /ERROR/ or $line =~ /FATAL/);
421 if (vec($rout, fileno(TASKMANAGER), 1))
423 $line = unbufferReadline(\*TASKMANAGER);
424 if(defined $line)
426 writelog("TaskManager: $line") if($line =~ /\S+/);
427 ++$tasksuccess if($tasksuccess == 0 && $line =~ /^connection opened for service on port \d+/);
428 ++$tasksuccess if($tasksuccess == 1 && $line =~ /^Opened connection with client/);
429 ++$tasksuccess if($tasksuccess == 2 && $line =~ /^Recieved ClientIdMsg/);
430 ++$tasksuccess if($tasksuccess == 3 && $line =~ /^Decrypting with key: /);
431 ++$tasksuccess if($tasksuccess == 4 && $line =~ /^succeeded/);
432 ++$tasksuccess if($tasksuccess == 5 && $line =~ /^ValidateAccountMessage/);
433 ++$tasksuccess if($tasksuccess == 6 && $line =~ /^ValidateAccountReplyMessage/);
434 ++$tasksuccess if($tasksuccess == 7 && $line =~ /^Permissions for \d+:/);
435 ++$tasksuccess if($tasksuccess == 8 && $line =~ /canLogin/);
436 ++$tasksuccess if($tasksuccess == 9 && $line =~ /canCreateRegularCharacter/);
437 ++$tasksuccess if($tasksuccess == 10 && $line =~ /^Recvd SelectCharacter message for \d+/);
438 ++$tasksuccess if($tasksuccess == 11 && $line =~ /^Got ValidateCharacterForLoginMessage acct \d+, character \d+/);
439 ++$tasksuccess if($tasksuccess == 12 && $line =~ /^Pending character \d+ is logging in or dropping/);
441 last if ($line =~ /ERROR/ or $line =~ /FATAL/);
446 return 0 if((time - $starttime) > $waittime);
447 last if($loginsuccess == 4 && $tasksuccess == 13);
450 writelog("LoginServer success: $loginsuccess/4, Taskmanager success: $tasksuccess/13");
451 return 0 if($loginsuccess != 4 || $tasksuccess != 13);
453 # Tell win32 machine that the client is ok (don't need to kill it)
454 print SOCKET CLIENT_OK;
456 read(SOCKET, $buffer, 1) == 1 or fatal "Error reading from win32 machine\n";
458 my $clientsuccess = 0;
459 $clientsuccess = 1 if($buffer eq SUCCESSFUL_TEST);
461 writelog("Client success: $clientsuccess/1");
462 return 0 if($clientsuccess != 1);
464 return 1;
467 sub testBootleg
469 print "Testing bootleg...\n";
470 writelog("Testing bootleg");
471 my $test = 0;
473 startServer();
474 startClient();
476 $test = checkResponses();
478 endServer();
479 endClient();
481 fatal "Test for bootleg $newbootleg unsuccessful\n" if(!$test);
482 print "Testing successful.\n\n";
483 writelog("Test for bootleg successful: $test");
484 open(BLESS, ">$bootlegdir/$branch/$newbootleg/blessed.txt");
485 close(BLESS);
487 return 1;
490 sub email
492 return 0 if($newbootleg eq "");
494 # Get old bootleg if we don't know it
495 if($oldbootleg eq "")
497 openClientSocket();
499 print SOCKET START_EMAIL;
500 # Tell the client which bootleg to ignore
501 print SOCKET pack("N", length $newbootleg);
502 print SOCKET $newbootleg;
504 my $buffer;
505 return 0 if(read(SOCKET, $buffer, 4) != 4);
506 my $oldBootlegLength = unpack("N", $buffer);
507 return 0 if($oldBootlegLength == 0);
508 return 0 if(read(SOCKET, $oldbootleg, $oldBootlegLength) != $oldBootlegLength);
510 close(SOCKET);
513 print "Emailing about changes from bootleg $oldbootleg to $newbootleg...\n";
514 writelog("Emailing changes from $oldbootleg to $newbootleg");
515 return 0 if($oldbootleg eq "");
516 open(EMAIL, "| mail -s \"[bootleg] $branch.$newbootleg.0 is up\" $emailRecipients");
518 print EMAIL "${bootlegdir}/\n".
519 "\n-Vijay\n\n";
521 print EMAIL "Changes between $oldbootleg and $newbootleg\n";
523 open(CHANGES, "perl ${depotdir}/swg/current/tools/BuildChanges.pl -i //depot/swg/$branch/... $oldbootleg $newbootleg |");
524 while(<CHANGES>)
526 next if(/^Change (\d+) on/ || /^\[(public|internal)\]/ || /^\n/ || /.?none.?/i || /n(\/|\.)a/i || /^---/ || /ignoring script recompile/i);
527 s/^\s*-?\s*//;
528 print EMAIL "\t- $_";
530 close(CHANGES);
531 print "Completed emailing.\n\n";
532 writelog("Completed emailing.");
534 return 1;
537 sub upkeep
539 my $buffer;
541 print "Performing upkeep on bootleg directory for $branch...\n";
542 writelog("Performing upkeep on bootleg directory for $branch...");
544 openClientSocket();
546 print SOCKET START_UPKEEP;
547 print SOCKET pack("N", length $branch);
548 print SOCKET $branch;
550 return 0 if(read(SOCKET, $buffer, 1) != 1);
552 if($buffer eq FAILED_GETTING_BUILD_CLUSTER_VERSION)
554 print "Failed getting build cluster version\n";
555 writelog("Failed getting build cluster version");
556 return 0;
558 elsif($buffer eq GOT_BUILD_CLUSTER_VERSION)
560 return 0 if(read(SOCKET, $buffer, 4) != 4);
561 my $buildClusterBootleg = unpack("N", $buffer);
562 print "Build cluster bootleg version is $buildClusterBootleg\n";
563 writelog("Build cluster bootleg version is $buildClusterBootleg");
565 else
567 print "Got incorrect return from win32 machine\n";
568 writelog("Got incorrect return from win32 machine.");
569 return 0;
572 while(1)
574 return 0 if(read(SOCKET, $buffer, 4) != 4);
575 my $bootlegVer = unpack("N", $buffer);
576 last if($bootlegVer == 0);
577 print "Removed bootleg $branch/$bootlegVer.\n";
578 writelog("Removed bootleg $branch/$bootlegVer.");
581 while(1)
583 return 0 if(read(SOCKET, $buffer, 4) != 4);
584 my $pdbFileLength = unpack("N", $buffer);
585 last if($pdbFileLength == 0);
586 return 0 if(read(SOCKET, $buffer, $pdbFileLength) != $pdbFileLength);
587 print "Removed pdb file $buffer.\n";
588 writelog("Removed pdb file $buffer.");
591 close(SOCKET);
594 sub submitOpenFiles
596 local $_;
597 my @files;
598 open(P4, "p4 -ztag opened -c default |");
600 while (<P4>)
602 chomp;
603 push (@files, $_) if (s/^\.\.\. depotFile //);
606 close(P4);
608 my $tmpfile = "submit.tmp";
610 # submit all the open files
611 open(TMP, ">" . $tmpfile);
613 print TMP "Change:\tnew\n";
614 print TMP "\nDescription:\n";
616 foreach (@_)
618 print TMP "\t", $_, "\n";
621 print TMP "\nFiles:\n";
622 foreach (@files)
624 print TMP "\t", $_, "\n";
627 close(TMP);
629 my $result = system("p4 submit -i < $tmpfile");
630 fatal "p4 submit failed" if ($result != 0);
631 unlink($tmpfile);
634 sub scriptRecompile
636 print "Recompiling scripts...\n";
638 writelog("Syncing perforce for script recompile...");
639 system("p4 sync //depot/swg/$branch/...") == 0 || return 0;
640 writelog("Sync perforce complete.");
641 writelog("Recompiling scripts...");
643 my $result = system("perl ${depotdir}/swg/current/tools/recompileAllScripts.pl $branch");
645 writelog("Recompile scripts returned $result (success = 0)");
647 if ($result != 0)
649 my $attach = "";
650 $attach .= " -a pythonPreprocessorStderr.log" if (-s "pythonPreprocessorStderr.log");
651 $attach .= " -a javac.log" if (-s "javac.log");
652 system("mutt -s \"[BUILDLOG $branch] script recompile failed, errors attached\" $attach $emailRecipients < /dev/null");
653 system("p4 revert -c default //depot/... > /dev/null");
654 return 0;
657 system("p4 revert -a > /dev/null");
658 submitOpenFiles("[automated]", "Script recompile for bootleg build");
660 print "Recompile scripts successful.\n";
661 return 1;
664 # ======================================================================
665 # Main
666 # ======================================================================
668 usage() if(!GetOptions('no_script' => \$steps[0], 'no_build' => \$steps[1], 'no_patch' => \$steps[2], 'no_send' => \$steps[3], 'no_install' => \$steps[4], 'no_test' => \$steps[5], 'no_email' => \$steps[6], 'no_upkeep' => \$steps[7]));
669 usage() if(@ARGV != 1);
671 # open the log file
672 open(LOG, ">>$logfile") || die "Could not open $logfile\n";
673 unbuffer(\*LOG);
675 $branch = shift;
676 print "Beginning bootleg build for branch $branch\n";
677 writelog("Beginning bootleg build for branch $branch");
679 scriptRecompile() || fatal "scriptRecompile" if(!$steps[0]);
680 buildBootleg() || fatal "build" if(!$steps[1]);
681 buildPatchTree() || fatal "buildPatchTree" if(!$steps[2]);
682 sendBootleg() || fatal "sendBootleg" if(!$steps[3]);
683 installBootleg() || fatal "installBootleg" if(!$steps[4]);
684 testBootleg() || fatal "testBootleg" if(!$steps[5]);
685 email() || fatal "email" if(!$steps[6]);
686 upkeep() || fatal "upkeep" if(!$steps[7]);
688 print "Build of bootleg $newbootleg complete.\n";
689 writelog("Build of bootleg $newbootleg complete");
691 close(LOG);