Some Cabie bug fixes: (too many to mention but this should still help) These fixes have been submitted to the author and should eventually make it into the official release. Many of the perl scripts required an explicit path and library path: #!/usr/local/bin/perl change to #!/usr/bin/perl BEGIN { push @LIB, "/opt/Cabie/server/lib"; } or export PERL5LIB=/opt/Cabie/server/lib ------------------------------------- server/lib/buildservermachinename.pm: ------------------------------------- Adding a password to the DB string should be pretty simple: DBAPASSWORD => "supersecretpassword", ---------------------- server/lib/unixsys.pm: ---------------------- my $dbpassword => $config->DBPASSWORD DBI->connect("dbi:mysql:database=builds;host=$sqlserver;password=$dbpassword", "$userid", "$dbpassword"); Add DBPASSWORD definition to server/lib/hostname.pm ---------------------- Found the fork process problem. Indication of the problem: table "proctree" ends up with multiple entry pairs where one of the "job" numbers is "0". You also end up with multiple instances of /opt/Cabie/server/buildserver.pl. Over time it will continue to launch new buildserver.pl process pairs without end. unixsys.pm sub forkprocess { ... ... my $pid = fork(); if (!$pid) { # pid is zero: child sleep($sleep); exec($cmd, @args); exit; <---- Add this line } ---------------------- server/lib/cmbroker.pm (V1.10) ---------------------- sub subversion_lastcheckout - Change from: $format = sprintf("%s by %s\n", $file, $version, $file, $formatmail); To: $format = sprintf("%s by %s\n", $file,$file, $version, $file, $formatmail); sub subversion_stdoutupdate { my $self = shift; my $title = shift; my $port = shift; my $client = shift; my $top = shift; my $dir = shift; my @contents; # # Usage message # if (!defined($title) || !defined($port) || !defined($client) || !defined($top) || !defined($dir)) { usage("subversion_stdoutupdate", "title, port, client, top, dir"); return; } chdir $top || die "chdir: to $top $? in subversion_stdoutupdate"; if ($client !~ /^!/) { if (! -d $client) { print STDOUT "subversion_stdoutupdate: no directory $entry\n"; } if($POSIX) { open(READ, "svn status -uq $top/$client|"); } else { open(READ, "cmd /c svn status -uq $top/$client|"); } while () { chop; if(!$POSIX) { chop; # munch on the extra character to make newline } if ($_ !~ /Status against revision/ && $_ !~ /^$/) { push @contents, "$_\n"; } } close(READ); } chdir $dir || die "chdir: $dir $? in subversion_stdoutupdate"; return @contents; } sub subversion_useraddress @users = `/usr/bin/GET $port/users.txt`; sub subversion_initchangeno { my $self = shift; my $client = shift; my $top = shift; my $entry; my $buildnum; my $nada; my $POSIX; my @info; if ($ =~ /MSWin32/) { $POSIX = 0; } else { $POSIX = 1; } # # Usage message # if (!defined($client)) { usage("subversion_initchangeno", "client"); return; } chdir($top); if ($POSIX) { @info = `svn info $client`; } else { @info = `cmd /c svn info $client`; } foreach $entry (@info) { chomp $entry; if ($entry =~ /^Last Changed Rev:/) { ($nada, $buildnum) = split(/Last Changed Rev: /, $entry); } } return $buildnum; } sub subversion_update { my $self = shift; my $title = shift; my $port = shift; my $client = shift; my $top = shift; my $dir = shift; if (!defined($title) || !defined($port) || !defined($client) || !defined($top) || !defined($dir)) { usage("subversion_update", "title, port, client, top, dir"); return; } chdir $top || die "chdir: $! in subversion_update"; if ($client !~ /^!/) { if($POSIX) { open(READ, "svn update $client|"); } else { open(READ, "cmd /c C:\\svn-win32-1.3.2\\bin\\svn.exe update $client |"); } open (SYNCLOG, ">$top/$title.sync.log") || die "open $top/$title.sync.log: $!"; while () { print SYNCLOG $_; } close(READ); close(SYNCLOG); } chdir $dir || die "chdir: $? in subversion_update"; } sub subversion_realchangeno # cd to the top of the build (where the log is) # chdir $top || die "chdir: $? subversion_realchangeno"; # # Make sure there's a sync log # if (! -f "$top/$title.sync.log") { chdir $dir || die "chdir: $? subversion_realchangeno"; } else { open (SYNCLOG, "<$top/$title.sync.log"); @updated = ; close(SYNCLOG); } # Extract latest revision updated if($POSIX) { open(TMP, "svn info $top/$client|"); } else { open(TMP, "cmd /c C:\\svn-win32-1.3.2\\bin\\svn.exe info $top/$client|"); } open(SYNCLOG, ">$tmp/svnupdate"); ... ... if ($numrecs) { while ($lastbuildno < $return) { if($POSIX) { @changeinfo = `svn log -r $lastbuildno -v $module[0]`; } else { @changeinfo = `cmd /c C:\\svn-win32-1.3.2\\bin\\svn.exe log -r $lastbuildno -v $module[0]`; } #@changeinfo = `svn log -r HEAD -v ./`; ... ... ... if ($entry =~ /^[ ]*D/) { if ($bChangeno) { ... ... ... } else { if($POSIX) { @fileinfo = `svn log -r COMMITTED -q $filename`; } else { @fileinfo = `cmd /c C:\\svn-win32-1.3.2\\bin\\svn.exe log -r COMMITTED -q $filename`; } ... ... sub subversion_verifyport -dummy routine. Return 0 Obtaining build number from Subversion using "svn info" you must perform "chdir $JobDir". The "svn info" command works on a local working directory and not on the web repository. Thus also change "svn info $port" to "svn info ." or "svn info $client" or however you have configured your system. Also: If there are no previous builds in database the system will not allow first build. This fixes this condition: sub subversion_realchangeno # Extract latest revision updated foreach my $line (@updated) { chomp $line; if ($line =~ /^Updated to revision/) { my ($left, $right) = split(/Updated to revision /, $line); $right =~ s/\.//g; $return = $right; # Return contains latest revision number $return =~ s/ //g; } # Add this if block if {$line =~ /^At revision/) { my ($left, $right) = split(/At revision /, $line); $right =~ s/\.//g; $return = $right; $return =~ s/ //g; } } open(SYNCLOG, ">$tmp/svnupdate"); foreach my $line (@updated) { chomp $line; if ($line !~ /^Updated to revision/ && $line !~ /^At revision/) { <<< Add the second condition in if statement. my ($action, $filename) = split(/[ ]+/, $line); my @module = split(/[\\\/]/, $filename); ... .. sub subversion_stdoutupdate Change the "svn status" arguments from "-u" to "-uq". --------------------- server/buildserver.pl (V1.15) --------------------- When setting sGood and bGood, remove the else which sets it to "0" in the loop. It causes the variable to always be set to zero after it sets it to "1" in the previous loop iteration. # # Look for supported SCCS system... # foreach my $tmplook (@supported) { if ($opts{s} =~ /^$tmplook$/i) { $sGood = 1; } else { $sGood = 0; } } Should be: # # Look for supported SCCS system... # foreach my $tmplook (@supported) { if ($opts{s} =~ /^$tmplook$/i) { $sGood = 1; } } This same logic also needs to be fixed in other locations in the file. -sub createjob Removed else sGood = 0; bug. ... if (!$POSIX) { if (($top !~ /^[A-Za-z]:\\([A-Za-z0-9_\-]+[\\])+/) || ($top =~ /[$dinvalidchars]/)) { _logevents("createjob invalid root spec\n",1); ... if (!$POSIX) { $tools =~ s/\//\\/g; if (($tools !~ /^[A-Za-z]:\\([A-Za-z0-9_\-]+[\\])+/) || ($tools =~ /[$dinvalidchars]/)) { _logevents("createjob invalid tool spec\n",1); -Have different lexical match for "sub createjob" setting of $top and $tools. Also in subroutine "pendingjobs": Initialization required so array wont get too large. sub pendingjobs ... ... while (1) { $c = 0; # Add this initialization inside the loop. @sqlarray = ""; if ( ! -f "$bsr/$pollfile"){ ... .. Remove $bCheck logic (always true ??) in sub pendingjobs -sub login_proc Add second line: $peername = gethostbyaddr($ipaddr, AF_INET); $peername =~ s/\..*//g; --------------------- server/bin/builder.pl (V1.10) --------------------- When obtaining output from pre, build, post and postpost: if POSIX ... "xxx.log 2>&1" should be ">xxx.log 2>&1" You need the ">" for perl on Linux to redirect output to the log file. -Remove redeclaration of $BuildNum. (todo) Initialize to 0. -Put dir variable in quotes: chdir "$dir"; (Is this different??) -Append two errors to @ErrorArray "Error", "ERROR" -Change: $BuildNum = $cmbroker->$sccscommand($port); to: if ($sccs eq "subversion") { $BuildNum = $cmbroker->$sccscommand($client,$top); } else { $BuildNum = $cmbroker->$sccscommand($port,$top); } -Add if block for subversion: if (!defined($BuildNum)) { chomp $sccs; # # Abstract to get an initial identifier for the build # $sccscommand = $sccs."_initchangeno"; if ($sccs eq "subversion") { $BuildNum = $cmbroker->$sccscommand($client,$top); } else { $BuildNum = $cmbroker->$sccscommand($port,$top); } } -sub MainBuildProc() -Added for functionality below: my @sqlarray; my $rValue; # Added to support postbuild reporting for test. my @proglist; -Note changes and additions: # Update build number with real change no $BuildNum = $RLCHG; $os->jobno("$BuildNum"); # # Set realchange number in config memory # $config->RLCHG("$RLCHG"); # # Call function to format the build number using FORMATNUMBER # if ($BuildNum == 0) { $BuildNum = _getjobid(); chomp $BuildNum; _debug ("BuildNum = $BuildNum"); # # Reset value now that it's been completed # $os->jobno("$BuildNum"); # # If we failed to generate a build number bail out # if (!$BuildNum) { _debug("failed to generate build number"); _notifyproblem("**Failed to generate build number**"); exit -1; } } - Diskspace check changed: # if (-d "$JobDir/$title/$BuildNum") { # $usedspace = _getusedspace("$JobDir/$title/$BuildNum", 1); if (-d "$top/$port") { $usedspace = _getusedspace("$top/$port", 1); -Log test results to alter color on web page. if ($ok == 0) { if($rValue == 0){ _debug("Build successful, but untested\n"); _logresults($BuildNum, $StartTime, $CompleteTime, 0); # Build ok but not tested } else { _debug("Build failed postbuild script!\n"); _logresults($BuildNum, $StartTime, $CompleteTime, 2); # Build failed - not ok exit 1; } } else { _debug("Build failed!\n"); _logresults($BuildNum, $StartTime, $CompleteTime, 2); # Build failed - not ok exit 1; } -Later in code: # Update build number with real change no $BuildNum = $RLCHG; $os->jobno("$BuildNum"); # # Set realchange number in config memory # $config->RLCHG("$RLCHG"); # # Call function to format the build number using FORMATNUMBER # if ($BuildNum == 0) { $BuildNum = _getjobid(); chomp $BuildNum; _debug ("BuildNum = $BuildNum"); # # Reset value now that it's been completed # $os->jobno("$BuildNum"); # # If we failed to generate a build number bail out # if (!$BuildNum) { _debug("failed to generate build number"); _notifyproblem("**Failed to generate build number**"); exit -1; } } --------------------- server/lib/unixsys.pm and winsys.pm --------------------- sub osprocesstree -Add exit for bad system behaviour exec($cmd, @args); exit; sub run_sql_query $sth->finish(); $dbh->disconnect; return @ret; This fix is for a new system installation where there is no job history in the database. It allows for the record to be updated if it exists in the jobs table. sub run_sql_submit { ... .. $picture =~ s/, $//g; if ($table eq "jobs") { $sth = $dbh->prepare("INSERT INTO $table VALUES($picture) ON DUPLICATE KEY UPDATE status='$values[5]'"); } else { $sth = $dbh->prepare("INSERT INTO $table VALUES($picture)"); } ... sub subversion_update sub validateargs Add to end of function: exit 0; -- This line exists at end of function } else { # # Look for -s (server port) # if (defined($Opts{s}) && $Opts{s} !~ /^$/ ) { if ($Opts{s} !~ /^[0-9]+$/ ) { print "Invalid port number!\n"; exit 1; } else { $self->{'sport'} = $Opts{s}; } } # # Look for -m (monitor port) # if (defined($Opts{m}) && $Opts{m} !~ /^$/ ) { if ($Opts{m} !~ /^[0-9]+$/ ) { print "Invalid port number!\n"; exit 1; } else { $self->{'mport'} = $Opts{m}; } } } Change from: while () { chomp; if ($_ !~ /Status against revision/ && $_ !~ /^$/) { push @contents, "$_\n"; } } To: while () { push @contents, "$_"; } This is because you remove string and later look for it but don't find it!! ------------------ web/cgi-bin/genweb (V1.8) ------------------ Use of the URL syntax CGI?$variable1&$variable2 should be CGI?$variable1?$variable2 ------------------------ server/lib/cabieaddon.pm ------------------------ File missing from release: ############################################################################# ## ## Copyright (c) Eric Wallengren, 2002 ## All Rights Reserved ## ## THIS WORK IS AN UNPUBLISHED WORK AND CONTAINS CONFIDENTIAL, PROPRIETARY, ## AND TRADE SECRET INFORMATION OF ERIC WALLENGREN. ACCESS TO THIS ## WORK IS RESTRICTED TO CAMPUS PIPELINE, INC. EMPLOYEES UNDER TERMS OF ## AGREEMENT BETWEEN ERIC WALLENGREN AND CAMPUS PIPELINE, INC. NO PART ## OF THIS WORK MAY BE USED, PRACTICED, PERFORMED, COPIED, DISTRIBUTED, ## REPRODUCED, REVISED, MODIFIED, TRANSLATED, ABRIDGED, CONDENSED, EXPANDED, ## COLLECTED, COMPILED, LINKED, RECAST, TRANSFORMED, ADAPTED, OR REVERSE ## ENGINEERED WITHOUT THE PRIOR WRITTEN CONSENT OF ERIC WALLENGREN. ANY USE ## OR EXPLOITATION OF THIS WORK WITHOUT EXPRESS AUTHORIZATION COULD SUBJECT ## THE PERPETRATOR TO CRIMINAL AND CIVIL LIABILITY. ## ############################################################################# # # Package declaration # package cabieaddon; # # Use Carp for error handling # use Carp; # # Configuration section, edit to suite build machine configuration... # To view configuration information from the server, use the # dumpconfig command. # my %fields = ( OWNER => 'Eric Wallengren', ); # # Generate readable time string from perl's 'time' function # sub _gen_time_string { my $self = shift; my $ts = shift; my $arg = shift; my $returnstring; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts); if ($arg == 1) { $returnstring = sprintf("%02d/%02d/%04d\@%02d:%02d:%02d\n", $mon+1, $mday, 1900 + $year, $hour, $min, $sec); } else { $returnstring = sprintf("%02d/%02d/%04d %02d:%02d:%02d\n", $mon+1, $mday, 1900 + $year, $hour, $min, $sec); } if ($arg == 99) { $returnstring = sprintf("%02d/%02d/%04d\n", $mon+1, $mday, 1900 + $year); } return $returnstring; } sub _printhead { my $shift = shift; my $pagetitle = shift; my $prompt = shift; my $logo = shift; my $dontshow = shift; # # Print standard information... # print < $pagetitle
\"LOGO\"


 $prompt
EOF if (!$dontshow) { print <Key :

Build Untested Build Passed Test Build Failed Failed Test

EOF } } sub _printtail { my $self = shift; my $shownone = shift; # # Print end of document. # print < "; } else { print " Eric Wallengren  "; } print <
   CABIE Copyright © 2002 EOF if ($shownone) { print "
EOF } # # Do not edit anything below this line... # # Object constructor... # sub new { my $that = shift; my $class = ref($that) || $that; my $self = { %fields, }; bless $self, $class; return $self; } # # Autoload definitions in this package... # sub AUTOLOAD { my $self = shift; my $type = ref($self) || croak "$self is not an object"; my $name = $AUTOLOAD; $name =~ s/.*://; unless (exists $self->{$name}) { croak "Can't access `$name` field in an object of class $type"; } if (@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } 1; ------------------------- Clearcase Support: ------------------------- Note: Use file stored build increment number (.version). Clearcase does not support the concept of a build number which can be querried as does Subversion. server/bin/builder.pl sub sysinfo my @supported = qw (perforce cvs subversion clearcase); sub MainBuildProc() if($sccs eq "clearcase") { $os->forkprocess( "/opt/rational/clearcase/bin/cleartool setview -exec './$script $top $type $title $BuildNum $sccs' build_view \"$client\" ". ">$top/$title/$BuildNum/$title.prebuild.log 2>&1", 1, 0); } else { $os->forkprocess( "./$script $top $type $title $BuildNum $sccs \"$client\" ". ">$top/$title/$BuildNum/$title.prebuild.log 2>&1", 1, 0); } ... ... Also note use of "system" to use a blocking call to make sure it is complete. ... if($sccs eq "clearcase"){ $os->forkprocess( "/opt/rational/clearcase/bin/cleartool setview -exec './$script $top $type $title $BuildNum $sccs' build_view \"$client\" ". ">$top/$title/$BuildNum/$title.postbuild.log 2>&1", 1, 0); } else{ # $os->forkprocess( # "./$script $top $type $title $BuildNum $sccs \"$client\" ". # ">$top/$title.postbuild.log 2>&1", 1, 0); @proglist = ("./$script", "$top", "$type", "$title", "$BuildNum", "$sccs", "\"$client\"", ">$top/$title/$BuildNum/$title.postbuild.log", "2>&1"); $rValue = system(@proglist); # Use blocking call and obtain results. } ... Also note use of "system" for postpostbuild. sub _runjob if($sccs eq "clearcase"){ $ret = $os->forkprocess( "/opt/rational/clearcase/bin/cleartool setview -exec '/bin/bash $script $top $title $BuildNum $sccs' build_view \"$client\" ". ">$top/$title/$BuildNum/$title.$type.log 2>&1", 1, 0); } else { $ret = $os->forkprocess( "/bin/bash $script $top $title $BuildNum $sccs \"$client\" ". ">$top/$title/$BuildNum/$title.$type.log 2>&1", 1, 0); } Add: sub clearcase_logfilelist - Same as Subversion. sub clearcase_format_pending sub clearcase_client sub clearcase_formatclientstring sub clearcase_formaturl sub clearcase_clientport sub subversion_update - Do nothing as MVFS is always up to date. ... ...