#!/usr/local/bin/perl
#
# Copyright (c) 2002-2004 Eric Wallengren
# This file is part of the Continuous Automated Build and Integration
# Environment (CABIE)
#
# CABIE is distributed under the terms of the GNU General Public
# License version 2 or any later version. See the file COPYING for copying
# permission or http://www.gnu.org.
#
# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED OR
# IMPLIED, without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. ANY USE IS AT YOUR OWN RISK.
#
# Permission to modify the code and to distribute modified code is granted,
# provided the above notices are retained, and a notice that the code was
# modified is included with the above copyright notice.
#
BEGIN {
push @INC, "lib";
push @INC, "../lib";
push @INC, "../../lib";
}
use File::Path;
use File::Copy;
use File::Basename;
use File::Find;
use Cwd;
use Cwd 'abs_path';
use Sys::Hostname;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use POSIX qw (:sys_wait_h);
#
# Get name of the build server
#
my $hostname = hostname();
$hostname =~ s/\.[a-zA-Z0-9\n]+//g;
my $ospackage;
#
# See what OS this is
#
if ($ =~ /MSWin32/) {
$ospackage = "winsys";
} else {
$ospackage = "unixsys";
}
require "$hostname.pm";
require "$ospackage.pm";
#
# Grab configuration data from buildconf
#
my $config = new $hostname;
my $os = new $ospackage;
my $cmd = $ARGV[0];
my $dir = getcwd();
my $i = @ARGV;
for ($a=1; $a < $i; $a++) {
push @Args, $ARGV[$a];
}
my $return = &$cmd(@Args);
exit $return;
sub removecomments {
my $sqlquery = "delete from comments where comment=\"Information:\n.\"";
$os->run_sql_remove($sqlquery);
}
sub nqueuetest {
my $testname = shift;
my $buildsvr = shift;
my $job = shift;
my $num = shift;
my $patchname = shift;
my $entry;
my @tests = split(/ /, $testname);
foreach $entry (@tests) {
my $sqlquery;
my @sqlarray;
my @empty;
my @submitarray = @empy;
my $tserver;
my $tdeploy;
my $timagename;
my $tbootscript;
my $ttitle = $entry;
my $tbldsvr = $buildsvr;
my $tjobname = $job;
my $tjob = $num;
$sqlquery = "select server, deployto, imagename, bootscript ".
"from testconfiguration where binary ".
"title=\"$entry\"";
@sqlarray = $os->run_sql_query($sqlquery, ";");
($tserver, $tdeploy, $timagename, $tbootscript)
= split(/;/, $sqlarray[0]);
$sqlquery = "select * from stage where binary title=\"$entry\" ".
"and binary jobname=\"$job\" and binary job=\"$num\"";
@sqlarray = $os->run_sql_query($sqlquery, ";");
if (!@sqlarray) {
push @submitarray, "$tserver";
push @submitarray, "$tdeploy";
push @submitarray, "$timagename";
push @submitarray, "$tbootscript";
push @submitarray, "$ttitle";
push @submitarray, "$tbldsvr";
push @submitarray, "$tjobname";
push @submitarray, "$tjob";
push @submitarray, "0";
push @submitarray, "$patchname";
$os->run_sql_submit("stage", @submitarray);
} else {
print "job $tjobname build $tjob from $tbldsvr already ".
"staged for deployment on $tdeploy\n";
}
}
}
sub queuetest {
my $testname = shift;
my $testserver = shift;
my $deployto = shift;
my $buildsvr = shift;
my $job = shift;
my $num = shift;
my $sqlquery;
my @sqlarray;
my @empty;
$sqlquery = "select title from stagetest where binary ".
"title=\"$testname\"";
@sqlarray = $os->run_sql_query($sqlquery, ";");
if (@sqlarray < 1) {
@sqlarray = @empty;
push @sqlarray, "$testserver";
push @sqlarray, "$deployto";
push @sqlarray, "$testname";
push @sqlarray, "$buildsvr";
push @sqlarray, "$job";
push @sqlarray, "$num";
push @sqlarray, "0";
$os->run_sql_submit("stagetest", @sqlarray);
}
}
sub cleancvsignore {
my $dir = shift;
if (! -d $dir) {
_logger( "invalid dir $dir\n" );
exit 1;
}
find(\&process_file, $dir);
}
sub p4params {
my $buildname = shift;
my $sqlquery = "select port, client from configuration where binary ".
"server=\"$hostname\" and binary title=\"$buildname\"";
my @sqlarray = $os->run_sql_query($sqlquery, ",");
my ($port, $client) = split(/,/, $sqlarray[0]);
my $user = $config->P4USER;
my $pass = $config->P4PASSWD;
print "-p $port -c $client -u $user -P $pass";
}
sub getvernum {
my $buildname = shift;
my $thisdir = shift;
if (! -d "$dir/$thisdir") {
print 0;
}
chdir ("$dir/$thisdir");
$ENV{"PWD"} = "$dir/$thisdir";
my @c4stuff = `c4 changes -m 1 ...`;
my @rec = split(/ /, $c4stuff[0]);
print $rec[1];
}
sub buildinfo {
my $buildname = shift;
my $buildnum = shift;
my $targetdir = shift;
my $isbody = 0;
my $formatted = "%s %s %s";
open(BIOUT, ">$targetdir/build.info.html") || die "open: $!";
$old_fh = select(BIOUT);
$| = 1;
select($old_fh);
print BIOUT "
$buildname $buildnum bill of materials".
"\n";
print BIOUT "";
open(BIIN, "<$targetdir/build.info") || die "open: $!";
while () {
chomp;
if ($isbody == 1) {
($mod, $file, $ver) = split(/ /, $_);
$string = sprintf("$formatted\n", $mod, $mod, $file, $ver, $file,
$ver);
print BIOUT "$string";
} else {
print BIOUT "$_\n";
}
if ($_ =~ /^---/) {
$isbody = 1;
}
}
close(BIIN);
print BIOUT "
\n";
print BIOUT "\n";
print BIOUT "\n";
close(BIOUT);
}
sub metrics {
my $bname = shift;
my $bnumber = shift;
my $pid;
my $home = $ENV{'HOME'};
$classpath = "$home/jncss/javancss17.37/lib/javancss.jar:".
"$home/jncss/javancss17.37/lib/ccl.jar:".
"$home/jncss/javancss17.37/lib/jhbasic.jar";
$ENV{'JAVA_HOME'} = "/usr/java";
$ENV{'JAVANCSS_HOME'} = "$home/jncss/javancss17.37";
pipe(READ, WRITE);
if ($pid = fork) {
close(WRITE);
} else {
die "cannot fork: $!" unless defined $pid;
# child
open (STDERR, ">/dev/null");
open(STDOUT, ">&=WRITE");
exec("java", "-classpath", "$classpath", "javancss.Main", "-all",
"-recursive");
}
_logger( "$bname metrics started $pid" );
open (METRICS, ">/tmp/$bname.buildmetrics.out") || die "open: $!";
while () {
print METRICS "$_";
}
close(READ);
close(METRICS);
_logger( "waiting on $pid" );
waitpid($pid, 0);
_logger( "$pid completed" );
}
sub removegenerated {
my $job = shift;
my $num = shift;
#
# SQL Stuff...
#
my $sqlquery;
my @sqlarray;
my $line;
my $port;
my $client;
my $sccs;
my $bHaschange = 0;
$sqlquery = "select port, client, sccs from configuration where ".
"binary server=\"$hostname\" and binary title=".
"\"$job\" and state=\"0\"";
open (DBG, ">/tmp/buildfuncs.dbg");
@sqlarray = $os->run_sql_query("$sqlquery", ";", 0);
foreach $line (@sqlarray) {
($port, $client, $sccs) = split(/;/, $line);
}
$ENV{'CVSROOT'} = "$port";
my @modules = split(/ /,$client);
foreach $line (@modules) {
_logger( "removegenerated module=$line" );
}
if ($sccs =~ /^cvs$/ ) {
my @children;
my $counter = 0;
my $nm = @modules;
my $archive;
my $bcommit;
_logger( "opening read/write pipe" );
pipe(READ, WRITE);
_logger( "pipe opened" );
foreach $entry (@modules) {
_logger("processing $entry");
if ($entry =~ /^!/) {
$entry =~ s/^!//g;
}
if ( -d $entry) {
_logger("going to fork for $entry");
if ($children[$counter] = fork) {
if ($counter == $nm-1) {
close(WRITE);
}
} else {
die "cannot fork: $!" unless defined $children[$counter];
open (STDERR, ">&=STDOUT");
open (STDOUT, ">&=WRITE");
exec ("cvs", "-n", "up", "-R", "$entry");
}
$counter++;
}
}
while () {
chomp $_;
_logger( "removegenerated $_" );
print DBG "$_\n";
($action, $name) = split(/ /, $_);
if ($action =~ /^\?$/) {
if (-f $name) {
print DBG "file: $name\n";
unlink ($name) || die "unlink: $?";
}
if (-d $name) {
print DBG "directory: $name\n";
rmtree ($name) || die "rmtree: $?";
}
}
if ($action =~ /M/) {
if ($name =~ /\.tar$/ic || $name =~ /\.zip$/ic
|| $name =~ /\.war$/ic || $name =~ /\.jar$/ic
|| $name =~ /\.car$/ic) {
if (! -d "/tmp/$job" ) {
system("mkdir -p /tmp/$job");
}
$archive = basename($name);
print DBG "File updated by build: $name\n";
system("cp $name /tmp/$job");
unlink($name);
system ("cvs up -dP $name >/dev/null 2>&1");
$bcommit = jdiff($name, "/tmp/$job/$archive");
print DBG "bcommit: $bcommit\n";
if ($bcommit) {
system("cp /tmp/$job/$archive $name >/dev/null 2>&1");
system("cvs ci -m \"auto-checkin of $archive from build $num of $job\" $name");
print DBG "cvs ci -m \"auto-checkin of $archive from build $num of $job\" $name";
}
} else {
print DBG "merge found: $name\n";
unlink($name);
system ("cvs up -dP $name >/dev/null 2>&1");
}
}
}
close(READ);
close(DBG);
foreach $c (@children) {
waitpid($c, 0);
}
} elsif ($sccs =~ /^perforce$/) {
if (! -f ".p4list.txt") {
_logger("no .p4list.txt for job $job\n");
return 0;
}
open(I, "<.p4list.txt");
@modules = ;
close(I);
my @vmodules;
my @children;
my $counter = 0;
my $nm = @modules;
my $archive;
my $bcommit;
my $here = $ENV{"PWD"};
foreach $entry (@modules) {
chomp $entry;
if (-d $entry) {
push @vmodules, $entry;
}
}
my $nm = @vmodules;
_logger( "opening read/write pipe" );
pipe(READ, WRITE);
_logger( "pipe opened" );
foreach $entry (@vmodules) {
chomp $entry;
_logger("processing $entry");
if ($entry =~ /^!/) {
$entry =~ s/^!//g;
}
if ( -d "$dir/$entry") {
print "chdir to $dir/$entry\n";
$ENV{"PWD"} = "$dir/$entry";
_logger("going to fork $entry");
if ($children[$counter] = fork) {
if ($counter == $nm-1) {
close(WRITE);
}
} else {
die "cannot fork: $!" unless defined $children[$counter];
open (STDERR, ">&=STDOUT");
open (STDOUT, ">&=WRITE");
chdir "$dir/$entry" || die "chdir: $?";
exec ("c4", "update", "-n", "...");
}
$counter++;
}
}
while () {
chomp $_;
if ($_ !~ /^Directory/) {
if ($_ =~ /^\?\?\?/) {
my $fn = $_;
$fn =~ s/\?+//g;
$fn =~ s/^ +//g;
$fn =~ s/^\t+//g;
$fullname = _getfullpath($fn, @vmodules);
print("rm $fullname\n");
unlink($fullname) || warn "unlink: $?";
} elsif ($_ =~ /^edit/) {
$fn = $_;
$fn =~ s/^edit//g;
$fn =~ s/^ +//g;
$fn =~ s/^\t+//g;
$fullname = _getfullpath($fn, @vmodules);
if ( $fullname !~ /propert/) {
my $archive = basename($fullname);
print "cp $fullname /tmp/$job/$archive\n";
system("cp $fullname /tmp/$job/$archive");
print("c4 sync -f $fullname");
system("c4 sync -f $fullname");
print "jdiff $fullname /tmp/$job/$archive\n";
my $isdiff = jdiff("$fullname", "/tmp/$job/$archive");
print "isdiff = $isdiff\n";
if ($isdiff) {
$bHaschange = 1;
print("cp /tmp/$job/$archive $fullname\n");
system("cp /tmp/$job/$archive $fullname");
system ("c4 open $fullname");
}
} else {
print "c4 sync -f $fullname\n";
system("c4 sync -f $fullname");
}
}
}
}
close(READ);
close(DBG);
foreach $c (@children) {
waitpid($c, 0);
}
if ($bHaschange) {
print("c4 change -o |sed \"s//auto checkin from $job $num/g\" |c4 submit -i");
system("c4 change -o |sed \"s//auto checkin from $job $num/g\" |c4 submit -i");
}
}
}
sub _getfullpath {
my $name = shift;
my @mods = @_;
my $entry;
$name =~ s/^\.\///g;
foreach $entry (@mods) {
if ( -f "$dir/$entry/$name") {
return "$dir/$entry/$name";
}
}
return "NOTFOUND: $name";
}
sub jdiff {
my $verbose = 0;
my $reallyverbose = 0;
my $file1 = shift;
my $file2 = shift;
my $members1;
my $members2;
my $checksum1;
my $checksum2;
my @memberarray1;
my @memberarray2;
my @sp;
my $sc;
my $ret;
my $m1;
my $m2;
#
# Make sure the list files exist...
#
die "$file1 not readable" if ! -r $file1;
die "$file2 not readable" if ! -r $file2;
#
# Stat the files, if the sizes have changed, then so have the
# contents...
#
my @stat1 = stat($file1);
my @stat2 = stat($file2);
#
# The 8th element in the stat array is the size (see stat and lstat)
#
if ($stat1[7] != $stat2[7]) {
if ($verbose) {
print STDERR "jdiff diffs found: filesize ($file1, $file2)\n";
}
return 1;
}
my $zip1 = Archive::Zip->new();
my $zip2 = Archive::Zip->new();
if ($verbose) {
print STDERR "reading $_[0]\n";
}
die "whoops" if $zip1->read($file1) != AZ_OK;
die "whoops" if $zip2->read($file2) != AZ_OK;
#
# This will probably never happen, but if for some chance the jar
# sizes are the same but the number of files in the archive are
# different, write to log file...
#
$members1 = $zip1->numberOfMembers();
$members2 = $zip2->numberOfMembers();
if ($members1 != $members2) {
if ($verbose) {
print STDERR "jdiff diffs found: members ($file1, $file2)\n";
}
return 1;
}
#
# Generate sorted member arrays...
#
@memberarray1 = sort($zip1->memberNames());
@memberarray2 = sort($zip2->memberNames());
#
# Use the first list for testing the second, there are
# the same number of entries, so if one has been renamed, we'll
# find it below...
#
foreach (@memberarray1) {
#
# We just want the file name...
#
@sp = split(/\//, $_);
$sc = @sp;
#
# Get information about the entry in the first jar archive...
#
$m1 = $zip1->memberNamed($_);
#
# We don't care about directories...
#
if (! $m1->isDirectory()) {
#
# This is where we'll catch the renaming of a file...
#
$m2 = $zip2->memberNamed($_);
if (! defined($m2)) {
if ($verbose) {
print STDERR "jdiff diffs found: noexist ($file1, $file2)\n";
}
return 1;
}
#
# Ignore the manifest...
#
if ("$sp[$sc-1]" !~ "MANIFEST.MF") {
#
# Get 32bit CRC's for entries...
$checksum1 = $m1->crc32String();
$checksum2 = $m2->crc32String();
if ($reallyverbose) {
$file1 =~ s/\\/\//g;
$file2 =~ s/\\/\//g;
print STDERR "\ncrc32 for $file1\->$_: $checksum1\n";
print STDERR "crc32 for $file2\->$_: $checksum2\n";
}
#
# If the checksums aren't the same return 1...
#
if ($checksum1 !~ /^$checksum2$/) {
if ($verbose) {
print STDERR "jdiff: checksums ($file1\->$_, $file2\->$_)\n";
}
return 1;
}
}
}
}
return 0;
}
sub logfile {
open (F, ">>$dir/jdiff.out");
print F "$_[0], $_[1]\n";
close(F);
}
sub process_file {
my $dir;
$fullname = $File::Find::name;
if (! -d "$fullname" && $fullname =~ /.cvsignore$/) {
$file = basename($fullname);
$dir = dirname($fullname);
if ($file =~ /\.cvsignore/) {
_logger( "process_file opening $dir/$file" );
open (CVSIG, "$dir/$file" ) || die "open: $?";
@contents = ;
close(CVSIG) || die "close: $?";
foreach $line (@contents) {
chomp $line;
if ( -f "$file" ) {
unlink("$dir/$line");
}
}
}
}
}
sub _logger {
my $string = shift;
my $formattime;
my $reqtime = scalar localtime;
print "[$reqtime]: $string\n";
}