#!/usr/local/bin/perl # @(#) $Header: /cvs/cabie/src/server/buildserver.pl,v 1.7 2004/12/18 00:29:41 getsw Exp $ # # 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. # use strict; no strict "refs"; # # The buildserver needs to be handled differently # on a non-posix system (Windows) # my $POSIX = 1; my $ospackage; # # See if this is a windoz system... # if ($ =~ /MSWin32/) { $POSIX = 0; $ospackage = "winsys"; } else { $ospackage = "unixsys"; } use Getopt::Std; my %Opts; use Socket; use FindBin; use Cwd; use threads; my $mthread; my $pthread; my $dir; $dir = cwd(); use Sys::Hostname; use File::Copy; use File::Path; use IO::Handle; use Mail::Sendmail; use Socket; BEGIN{push @INC, "lib";} use RPC; use RPCStd; # # Use signal handler to trap signal errors # use sigtrap qw (handler _catch_sig normal-signals stack-trace error-signals); # # We don't care about child processes. # $SIG{CHLD} = 'IGNORE'; my $hostname = hostname(); $hostname =~ s/\.[a-zA-Z0-9]+//g; # # Load master configuration file # require "$hostname.pm"; # # Create instances of packages enabled above... # my $config = new $hostname; # # unixsys for posix # winsys for windows # require "$ospackage.pm"; # # Create instances of packages enabled above... # unixsys for posix # winsys for windows # my $os = new $ospackage; # # Change directories to where the buildserver lives # chdir $config->BSR; $dir = cwd(); # # Use this for overriding default environment variables # if (-f "$dir/config/vars.conf") { open (VARIN, "<$dir/config/vars.conf"); open (VAROUT, ">vars.set"); while () { chomp; my ($envname, $envvalue) = split(/=/, $_); $ENV{"$envname"} = "$envvalue"; print VAROUT "$envname = $envvalue\n"; } close (VAROUT); close(VARIN); } open (DEBUGGER, ">$dir/proc/dbg.log"); DEBUGGER->autoflush(1); unshift (@INC, "lib"); # Prepend a directory name # # Some boolean globals for forking... # my ($bMonitor, $bServer, $bDaemon); # # Process options... # if ($POSIX) { getopts('s:m:d', \%Opts); } else { getopts('s:m:irx', \%Opts); } my $hostname = hostname(); $hostname =~ s/\.[a-zA-Z0-9]+//g; my $port = $os->port; my $sport = $os->sport; my $mport = $os->mport; my $makedaemon = $os->makedaemon; my $makemonitor = $os->makemonitor; my $logext = "connectlog"; my $errlogext = "errorlog"; my $host = "$hostname"; my @addresses = gethostbyname($hostname); @addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses]; # $hostname = gethostbyaddr(inet_aton($addresses[0]), AF_INET) # || die "Can't resolve $addresses[0]: $!\n"; # # Use generic routine from OS package to validate args passed # to the buildserver... # $os->validateargs($hostname, %Opts); # # Name of this buildserver, and boolean value for authorization # my $name = "$hostname"; my $authorized = 0; # # Globally declared sccs # my $globsccs; # # Use for supported SCCS systems... # my $bIsPerforce = 0; my $bIsCvs = 0; # # Reusable functions... # use Bldsvr; # # Call CM broker # use cmbroker; my $cmbroker = new cmbroker; # # Start global declarations # my $kidpid; my $item; my $peeraddress; my $peername; my $reqtime; my $isinternal = 0; my $isexternal = 0; my $bBuild = 0; my @myout; my @cmdarray; # # Primarily unused # my $CVSROOT = $config->CVSROOT; # # Use for keep and free commands # # OS SPECIFIC my $Moutdir = $config->JOBDIR; my $Mtmpdir = $config->BTMP; my $Mnull = $config->NULL; # # Icons... # my $disicon = $config->DISICON; my $cgibin = $config->CGIBIN; my $logo = $config->LOGOICON; my $greenicon = $config->GREENICON; my $redicon = $config->REDICON; my $yellowicon = $config->YELLOWICON; my $runicon = $config->RUNICON; my $openicon = $config->OPENFOLD; my $closedicon = $config->CLOSEDFOLD; my $promoicon = $config->PROMOICON; my $webserver = $config->WEBSERVER; my $tested = $config->TESTED; my $nottested = $config->NOTTESTED; # # Perforce user # my $p4user = $config->P4USER; # # Vars for genweb... # my @PLATFORM = ( "$hostname" ); # # More globals, these are for the generation of the web display # my %emptyhash; my @emptyarray; my %mainhash; my %jobhash; my @jobarray; my @stats; my %idlehash; my %statehash; my @reversearray; my @timearray; my %workhash; my $viewitems; my $HASARGS; my $itsnow; my @webarray; my %jobHash; # Found by strict my @JobList; # # Colors used for genweb # my @colorarray = ( "#33cc99", "#dc1973", "#fe5066", "#b9ffb9", "#ffcc00", "#bed2ff", "#669999", "#ff9248" ); # # Error messages... # my %msghash = ( 0, "Command request accepted", 1, "Previous job running", 2, "Job undefined", 3, "Unsupported request", 4, "Help request", 5, "locked job", 6, "unable to change status", 7, "invalid arguments", 8, "cat what?", 9, "incomplete request", 10, "build what?", 11, "\(command not yet supported\)", 12, "entry already exists", 13, "entry does not exist", 14, "no jobs defined on server", 15, "status change pending", 16, "job has never been defined", 17, "job is already defined", 18, "build not found", 19, "build already promoted", 20, "failed to make directory", 21, "out of disk space", 22, "no such server", 23, "command not supported" ); # # Command set. # # command, [I:E] internal call or external application function/file # # sharedcmds: all users # smsharedcmds: monitor running on alteranate port # usercmds: ip address # admincmds: for those authorized to run the build command # # admin and shared are concatenated # user and shared are concatenated # smshared are all by themselves # # # Commands used by both the user and admin modes # my %sharedcmds = ( "commands", "I display_commands", "help", "I display_command_usage", "jobstate", "I jobstate", "runstats", "I runstats", "elapsed", "I elapsed", "ps", "I do_ps", "status", "I build_status", "incomplete", "I get_fails", "describe", "I describe_job", "subscribe", "I subscribe", "subscribers", "I subscribers", "unsubscribe", "I unsubscribe", "instructions","I instructions", "whatsnew", "I whatsnew", "errorlog", "I geterror_log", "synclog", "I getsync_log", "buildlog", "I getbuild_log", "joblog", "I do_joblog", "laststart", "I get_starts", "lastchange", "I get_changes", "genweb", "I genweb", "removed", "I show_removed", "changed", "I changed", "servers", "I servers", "debuglog", "I debuglog", "sysinfo", "I sysinfo" ); # # Commands used by forked monitor process, windows will have extra # shutdown command. # my %smadmincmds; my %smsharedcmds; %smadmincmds = ( "pendingtest", "I pendingtest", ); if ($POSIX) { %smsharedcmds = ( "help", "I display_command_usage", "commands", "I display_commands", "nextjob", "I get_syncs", "run", "I external", "passed", "I passed" ); } else { %smsharedcmds = ( "help", "I display_command_usage", "commands", "I display_commands", "nextjob", "I get_syncs", "passed", "I passed", "run", "I external", "shutdown", "I shutdown" ); } # # Help hash for shared commands # my %smsharedhelptable = ( "nextjob", "\nUsage:\n\tnextjob -n jobname\n\tdisplay updates ". "CM system will make for jobname with next sync\n", "commands", "\nUsage:\n\tcommands -l -w \n\tDisplay supported ". "command set\n", "passed", "\nUsage:\n\tpassed -n jobname -j jobno\n\tmarks build ". "as good and keeps it until free'd by request\n" ); # # User only commands # my %usercmds = ( "rejectlog", "I my_reject_log", "connectlog", "I my_connect_log" ); # # Admin only commands # my %admincmds = ( "build", "E $dir/bin/builder.pl", "disable", "I lock_build", "kill", "I do_kill", "set", "I do_set", "enable", "I unlock_build", "authorize", "I authorize", "unauthorize", "I unauthorize", "authorized", "I whosauthorized", "rejectlog", "I reject_log", "connectlog", "I connect_log", "adduser", "I adduser", "deluser", "I deluser", "restorejob", "I addjob", "removejob", "I deljob", "createjob", "I createjob", "nextjob", "I get_syncs", "keep", "I keep", "free", "I free", "getid", "I getid", "dumpconfig", "I dumpconfig", "notify", "I notify", "shutdown", "I shutdown", "promote", "I promote", "recover", "I recover", "clone", "I clone", "cvsperms", "I changecvsmodule" ); # # Declare hash for commands # my %supportedcmds; # # Help hash for shared commands # my %sharedhelptable = ( "commands", "\nUsage:\n\tcommands -l -w \n\tDisplay supported ". "command set\n", "passed", "\nUsage:\n\tpassed \n\tmarks build ". "as passed test", "help", "\nUsage:\n\thelp [command]\n\tDisplay [command] usage\n", "incomplete", "\nUsage:\n\tincomplete -n jobname [-l limit] ". "\n\tWill display \(optionally limit\) build numbers ". "of failed builds \n\tfor jobname\n", "jobstate", "\nUsage:\n\tjobstate\n\tDisplay buildserver job status\n", "runstats", "\nUsage:\n\trunstats -n job [-l number -a -r]". "\n\n\tDisplay statistics for [optionally -l] last ". "build jobs\n\t-a displays only the average build time\n". "\t-r displays raw time in ticks \(seconds\) useful\n". "\tfor feeding into a script\n", "elapsed", "\nUsage:\n\telapsed -n job\n\tDisplay elapsed time for ". "current build job\n", "ps", "\nUsage:\n\tps options\n\tBuild Unix style process table ". "on the server\n", "status", "\nUsage:\n\tstatus -n job \n\tCheck build status\n", "describe", "\nUsage:\n\tdescribe -n job\n\tdescribe charastics of ". "defined job\n", "subscribe", "\nUsage:\n\tsubscribe -n jobname -e emailaddress". "\n\tsubscribe for automatic email notification of ". "defined job\n", "subscribers", "\nUsage:\n\tsubscribers -n jobname\n\tdisplay email ". "subscription list for a defined job\n", "unsubscribe", "\nUsage:\n\tunsubscribe -n jobname -e emailaddress". "\n\tunsubscribe from automatic email notification of ". "defined job\n", "instructions","\nUsage:\n\tinstructions -n jobname\n\tinstructions ". "for building a defined job locally\n", "whatsnew", "\nUsage:\n\twhatsnew\n\tdisplay latest changes made to ". "the build server\n", "sysinfo", "\nUsage:\n\tsysinfo\n\tdisplay hardware/software ". "configuration for $hostname\n", "errorlog", "\nUsage:\n\terrorlog -n jobname -t retail|debug ". "\n\tretrieve errorlog of defined job\n", "synclog", "\nUsage:\n\tsynclog -n jobname\n\tretrieve synclog ". "of defined job\n", "joblog", "\nUsage:\n\tjoblog -n jobname\n\tcomplete run log of ". "defined job\n", "debuglog", "\nUsage:\n\tdebuglog -n jobname\n\tcomplete debug log ". "of defined job\n", "buildlog", "\nUsage:\n\tbuildlog -n jobname -t retail|debug\n\t". "retrieve buildlog of defined job\n", "connectlog", "\nUsage:\n\tconnectlog [-l limit]\n\tdisplay client ". "connection log [limit to limit number of recs]\n", "rejectlog", "\nUsage:\n\trejectlog [-l limit] \n\tdisplay client ". "rejection log [limit to limit number of recs]\n", "laststart", "\nUsage:\n\tlaststart [-l n]\n\tdisplay last [n] ". "buildserver starts\n", "lastchange", "\nUsage:\n\tlastchange -n jobname [-l n]\n\tdisplay last ". "[n] updates for jobname.\n", "genweb", "\nUsage:\n\tgenweb -n joblist -l limit\n\tGenerate web ". "view of buildserver status for jobs in joblist \n\t". "Display up to last limit jobs\n", "removed", "\nUsage:\n\tremoved\n\tdisplay jobs ". "no longer under the buildserver's control\n", "servers", "\nUsage:\n\tservers\n\tdisplay other ". "build servers\n", "changed", "\nUsage:\n\tchanged -n jobname -j jobno [-e endjobno]\n\t". "Display list of files updated for job jobno\n" ); # # Help hash for Admin commands # my %adminhelptable = ( "build", "\nUsage:\n\tbuild -n jobname [-j jobno]\n\n", "disable", "\nUsage:\n\tdisable -n job\n\tDisable build job\n", "kill", "\nUsage:\n\tkill -p pid -s signal\n\tkill process ". "by PID \(see ps\)". " on the server\n", "enable", "\nUsage:\n\tenable -n job [-f -k]\n\tEnable build job ". "\n\t[-f force semaphore removal]\n\t[-k kill running ". "build process] (requires -f)\n", "authorize", "\nUsage:\n\tauthorize -c computername\n\tauthorize ". "computername to control builds\n", "unauthorize", "\nUsage:\n\tunauthorize -c machinename\n\tremove ". "computername from authorization list\n", "authorized", "\nUsage:\n\tauthorized\n\tdisplay list of computers ". "authorized to control builds\n", "adduser", "\nUsage:\n\tadduser -p port -u username -f first ". "-l last [-m mail ] [-g group]\n\tAdd new user to CM ". "server\n", "deluser", "\nUsage:\n\tdeluser -p port -u username [-f first ". "-l last -g group]\n\tRemove user from CM server\n", "restorejob", "\nUsage:\n\trestorejob -n jobname". "\n\tAdd previously defined job back to the buildserver\n", "removejob", "\nUsage:\n\tremovejob -n jobname [-f]". "\n\tRemove defined job from the buildserver ". "[-f permanent deletion]\n", "nextjob", "\nUsage:\n\tnextjob -n jobname\n\tdisplay updates ". "CM system will make for jobname with next sync\n", "createjob", "\nUsage:\n\tcreatejob -n jobname ". "\n\t -p (p4 port/cvs root)". "\n\t -c (p4 client/cvs module)". "\n\t -r sourceroot". "\n\t -t debug|retail|both". "\n\t -d toolsdir". "\n\t -k keeplevel". "\n\t -s sccs". "\n\t -b browserlink". "\n\t -m global failure notification". "\n\t -C \"comment\"". "\n\t [-D] dump existing job in cmd line format\n", "keep", "\nUsage:\n\tkeep -n jobname -j jobno [-c comment]". "\n\tKeep jobname for build jobno from being automatically ". "deleted\n", "free", "\nUsage:\n\tfree -n jobname -j jobno". "\n\tRelease locks allowing jobno for build jobname ". "to be deleted\n\tby the buildserver\n", "getid", "\nUsage:\n\tgetid". "\n\tDisplay buildserver process ID\n", "shutdown", "\nUsage:\n\tshutdown". "\n\tshutdown buildserver processes\n", "dumpconfig", "\nUsage:\n\tdumpconfig". "\n\tDisplay buildserver configuration loaded from ". "buildconf.pm\n", "promote", "\nUsage:\n\tpromote -n jobname -j jobno -c \"comment\"". "\n\tPromote jobname jobno for formal testing\n", "recover", "\nUsage:\n\trecover -n jobname". "\n\tRecover active jobs accidently removed by enable ". "command\n", "clone", "\nUsage:\n\tclone -n oldjobname -c newjobname". "\n\tCreate new job by copying oldjob configuration\n", "cvsperms", "\nUsage:\n\tcvsperms \"users\"". "\n\tUpdate module userlist\n", "notify", "\nUsage:\n\tnotify -n jobname -f firstjob -l lastjob ". "-c comment\n\tSend email with comment to all submitters ". "of jobname\n\tfrom firstjob to lastjob\n" ); # # Declare hash table for help # my %helptable; # # Start time of the build server # my $serverstarttime = sprintf "%s", scalar localtime; $os->startdaemons($dir, %Opts); chdir $config->BSR; if ($os->bAmMonitor) { %sharedcmds = %smsharedcmds; %admincmds = %smadmincmds; %sharedhelptable = %smsharedhelptable; # # We can call the function directly from threads under # unix otherwise we pass a reference # if ($POSIX) { $mthread = threads->new("polljobs"); } else { $mthread = threads->new(\&polljobs); } $logext = "_connectlog"; $errlogext = "_errorlog"; $sport = $os->sport; } else { if ($POSIX) { $pthread = threads->new("pendingjobs"); } else { $pthread = threads->new(\&pendingjobs); } } RPC->new_server($host, $os->port); if (!$os->makedaemon) { $port = $sport; print "***$port non-daemon starting server***\n"; RPC->new_server($host, $port); } # # Flush any data written to STDIO # STDOUT->autoflush(1); STDERR->autoflush(1); # # Add entry about server in SQL # if ($os->bAmServer) { _registerserver(); } # # Get the current time # my $sreqtime = scalar localtime; # # Log buildserver start # _logevents("[$sreqtime $name]: buildserver connectlog session started", 0); _logevents("[$sreqtime $name]: buildserver rejectlog session started", 1); # Print to the console the server status... print "[$sreqtime $name]: waiting for events\n"; # Wait for an incoming request... if ($os->bAmServer) { RPC->event_loop(); } else { RPC->event_loop(); } # Here's the login function, we'll look for command authorization... #------------------------------------------------------------------- sub login_proc { # # For use with mysql # my $sqlquery; my @sqlarray; my $line; # Get the connection handle... my ($conn) = shift; # Assume that there's no build authorization... $authorized = 0; # Get the socket from the connection handle... my $socket = $conn->{sock}; # Get the client name from the socket... my $other_end = getpeername($socket); # Get the ip address for the host... my ($port, $ipaddr) = unpack_sockaddr_in($other_end); my $actual_ip = inet_ntoa($ipaddr); # Get the host name... $peername = gethostbyaddr($ipaddr, AF_INET); if (!defined($peername)) { $peername = $actual_ip; } # Use $peeraddress for console messages... $peeraddress = "$peername"." \($actual_ip\)]"; # # SQL way to determine authorization... # $sqlquery = "select machine from authtable where ". "binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray == 0) { $authorized = 1; } else { foreach $line (@sqlarray) { chomp $line; if ($peername =~ /^$line$/i) { $authorized = 1; } } } if ($authorized) { %supportedcmds = (%sharedcmds, %admincmds); %helptable = (%sharedhelptable, %adminhelptable); } else { %supportedcmds = (%sharedcmds, %usercmds); %helptable = (%sharedhelptable); } $reqtime = sprintf "[%s", scalar localtime; } sub cmd_broker { my $conn = shift; login_proc($conn); @ARGV = @_; my $msg = shift; # Variables to be used by this subroutine... my $buildreq; my $ServerName; my $cmd; my $ret; my $sqlquery; my @sqlarray; my @JOBArray; my @returnarray; @cmdarray = @emptyarray; # # Was there a message from the client # if (defined $msg && $msg !~ /^$/) { # Strip newline chomp $msg; @cmdarray = split(/ /,$msg); # Create cmd array $cmd = shift @cmdarray; # Search hash for supported request my $cmdtype = $supportedcmds{$cmd}; if (!defined($cmdtype)) { return $msghash{3}; _logevents("$msghash{3}: \"$msg\"\n",1); return ""; } # # Determine internal/external function. # my ($int_ext, $function) = split(/ /, $cmdtype); # If cmd is valid if (defined($cmd)) { # We need to determine if this is a build command, special # handling needs to take place if it is... if ($cmd =~ /^build$/) { my %Buildopts; my @newarray = _parsearray(@cmdarray); @ARGV = @newarray; getopts('n:j:S:', \%Buildopts); $buildreq = $Buildopts{n}; $ServerName = $Buildopts{S}; # # See if servername is defined # if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { # # This is a build... # my $locked; $bBuild = 1; # # Make sure a jobname was sent # if (!defined($buildreq)) { return(display_command_usage("build")); _logevents("$msghash{9}: $msg\n",1); } # # Make sure it's a valid active job # if (!_ValidJob($buildreq,$hostname,0)) { return ("undefined job $buildreq"); _logevents("$msghash{2}: $cmdarray[0] $buildreq\n",1); return ""; } # # SQL query to see if it's in a locked state # $sqlquery = "select message from semaphores where binary ". "title=\"$buildreq\" and binary server=". "\"$hostname\" limit 1"; @sqlarray = $os->run_sql_query($sqlquery, ";"); # # See if sql returned a record and return it to # the client. # $locked = @sqlarray; if ($locked) { return("$sqlarray[0]"); _logevents("$cmd $buildreq $hostname: $sqlarray[0]",1); return ""; } # # Check for free space... # if ((_freespace($buildreq)) == 1) { return($msghash{21}); # Display a message to stdout _logevents("$msghash{21}: $msg\n",1); return ""; } # # Call the build. # external($function, @newarray); return($msghash{0}); # Display a message to the console... _logevents("$msg\n",0); } else { @returnarray = _clientcall($ServerName, "build", "-n", "$buildreq"); return("@returnarray"); } } else { # # Is this an external command? # if ($int_ext =~ /E/) { my @newarray = _parsearray(@cmdarray); external($function, @newarray); return($msghash{0}); _logevents("$msg\n",0); } else { my @newarray = _parsearray(@cmdarray); # Run subroutine, send back results... my @return = &$function(@newarray); return(@return); } } } else { # Unsupported request... return($msghash{3}); if ($msg != "") { # Display a message to the console... _logevents("$msghash{3}: \"$msg\"\n",1); } } # Undefine msg, wait for new event... undef $msg; # Display a message to the console... $sreqtime = scalar localtime; print "[$sreqtime $name]: waiting for events\n"; } else { return ""; } } # # Call an external command # sub external { # # Get command and arg list # my $cmd = shift; my @localarg = @_; # # Use argv for getopts. # @ARGV = @_; # # Getopts in case we're calling a build # my %Options; my $jobname; my $jobno; my $ret; # # Scalar for process id # my $pid; # # SQL array use to push values into proctree table # my @sqlarray; # # Call getopts # getopts('n:j:', \%Options); # # Assign jobname and jobno (if supplied) # $jobname = $Options{n}; $jobno = $Options{j}; # # Call forkprocess and return with pid # $pid = $os->forkprocess($cmd, 0, 0, @localarg); # # If the global build boolean is set then push process values # onto the proctree table # if ($bBuild) { # # Push values onto array push @sqlarray, "$hostname"; push @sqlarray, "$jobname"; # # If we're sent the jobno then use that value initially # otherwise use pid as reference into proctable (it will # be replaced by jobno during the build) # if (defined($jobno)) { push @sqlarray, "$jobno"; } else { push @sqlarray, "$pid"; } # # Push args sent along with the pid # push @sqlarray, "$cmd @localarg"; push @sqlarray, "$pid"; # # Submit values into SQL # $os->run_sql_submit("proctree", @sqlarray); # # Set boolean value back to false # $bBuild = 0; } return $pid; } # # Add user to Perforce server... # sub adduser { @ARGV = @_; my %Options; my $port; my $user; my $first; my $last; my $group; my $mail; my $sccs; my $command; getopts('p:u:f:l:g:m:', \%Options); $port = $Options{p}; $user = $Options{u}; $first = $Options{f}; $last = $Options{l}; $group = $Options{g}; $mail = $Options{m}; if (!defined($group)) { $group = $config->DEFGROUP; } if (!defined($mail)) { $mail = "$user\@".$config->COMPANY; } if (!defined($port) || !defined($user) || !defined($first) || !defined($last)) { _logevents("adduser @_: invaild args\n",1); return display_command_usage("adduser"); } $sccs = detectsccs($port); $command = $sccs."_useradmin"; my $message = $cmbroker->$command($port, $user, $first, $last, $mail, $group, 0); if ($message =~ /command failed:/) { _logevents("adduser @_: could not add user\n",1); return "$message: unable to add user $user to port $port"; } else { _logevents("adduser @_: user added\n",0); return "$user ($mail) added to $port"; } } # # Remove user from Perforce server... # sub deluser { @ARGV = @_; my %Options; my $port; my $user; my $first; my $last; my $group; my $mail; my $sccs; my $command; getopts('p:u:f:l:g:m:', \%Options); $port = $Options{p}; $user = $Options{u}; $first = $Options{f}; $last = $Options{l}; $group = $Options{g}; $mail = $Options{m}; if (!defined($group)) { $group = $config->DEFGROUP; } if (!defined($mail)) { $mail = "$user\@".$config->COMPANY; } if (!defined($first)) { $first = "nobody"; } if (!defined($last)) { $last = "nobody"; } $sccs = detectsccs($port); $command = $sccs."_useradmin"; if (!defined($port) || !defined($user)) { _logevents("deluser @_: invaild args\n",1); return display_command_usage("adduser"); } my $message = $cmbroker->$command($port, $user, $first, $last, $mail, $group, 1); if ($message =~ /command failed:/) { _logevents("adduser @_: could not remove user\n",1); return "$message: unable to delete user $user from port $port"; } else { _logevents("deluser @_: user removed\n",0); return "$user removed from $port"; } } # # Grab the id of the running process # sub getid { @ARGV = @_; my $ServerName; my %Options; my @dirarray; my @dirarray2; my @returnarray; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { # Get contents of the pid file... @dirarray = _catfile("$Mtmpdir/.buildserver.id"); @dirarray2 = _catfile("$Mtmpdir/.sourcemonitor.id"); # Display a message to the console... _logevents("getid @_\n",0); push @returnarray, "\n"; push @returnarray, $dirarray[0]; push @returnarray, $dirarray2[0]; } else { @returnarray = _clientcall($ServerName, "getid"); } # Return the command array... return @returnarray; } # # Show all buildservers # sub servers { @ARGV = @_; my $ServerName; my $entries; my $sqlquery; my @sqlarray; my $state; my $line; my $string; my @return; my %Options; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { $sqlquery = "select server, description, port, status ". "from buildservers where binary server != ". "\"$ServerName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); push @return, "\n"; $string = sprintf ("%-15s %-6s %-6s %-50s\n", "Server Name", "Port", "State", "Description"); push @return, $string; $string = sprintf ("%-15s %-6s %-6s %-50s\n", "==========", "=====", "=====", "=========="); push @return, $string; foreach $line (@sqlarray) { my ($server, $description, $port, $status) = split (/;/, $line); if ($status) { $state = "up"; } else { $state = "down"; } my $tmpstring = sprintf("%-15s %-06d %-6s %-50s\n", $server, $port, $state, $description,); push @return, $tmpstring; } push @return, "\n"; # Display a message to the console... _logevents("servers\n",0); } else { @return = _clientcall($ServerName, "servers"); } return @return; } # # Shutdown the build server in a posix environment # sub shutdown { @ARGV = @_; my $entries; my $serverid; my $monitorid; my $sqlquery; my @sqlarray; my $ServerName; my %Options; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { $isinternal = 1; my @ids = getid(); foreach $entries (@ids) { my ($left, $right) = split(/:/, $entries); chomp $right; if ($left =~ /server/) { $serverid = $right; $serverid =~ s/ //g; } else { $monitorid = $right; } } # # Have status set to 0 for buildserver # $sqlquery = "update buildservers set status=\"0\" ". "where binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); # Display a message to the console... _logevents("shutdown\n",0); if ($POSIX) { print "monitor: $monitorid, server: $serverid\n"; $os->forkprocess("kill -9 $monitorid $serverid", 0, 2); } else { $os->shutdown(); } } else { _clientcall($ServerName, "shutdown"); } return "shutting down"; } # # Print current configuration data loaded from buildconf.pm # sub dumpconfig { @ARGV = @_; my @ret; my $line; my $ServerName; my %Options; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { push @ret, "\n"; push @ret, "See buildconf.pm for comments!\n\n"; foreach my $key (sort keys %{$config}) { $line = sprintf "%-15s = %s\n", $key, $config->{$key}; push @ret, $line; } _logevents("dumpconfig", 0); } else { @ret = _clientcall($ServerName, "dumpconfig"); } return @ret; } # # Generate a process table, internal... # sub do_ps { @ARGV = @_; my $ServerName; my %Options; # Use generic routine from the Bldsvr package my @psarray; getopts('S:', \%Options); $ServerName = $Options{S}; if ($ServerName =~ /^$hostname$/) { undef $ServerName; } if (!defined($ServerName)) { $ServerName = $hostname; # Display a message to the console... if ($POSIX) { @psarray = cmd_array("ps -ef"); } else { @psarray = $os->processtable(); } # Display a message to the console... _logevents("ps $ServerName\n",0); } else { @psarray = _clientcall($ServerName, "ps"); } # Return the command array... return @psarray; } # # Kill processes remotely # sub do_kill { @ARGV = @_; my @dirarray; my $entry; my $exitcode; my $ServerName; my $Process; my $Signal; my %Options; my @remoteargs = @emptyarray; getopts('S:p:s:', \%Options); $ServerName = $Options{S}; $Process = $Options{p}; $Signal = $Options{s}; if ($ServerName =~ /^$hostname$/) { undef $ServerName; } if (!defined($ServerName)) { $ServerName = $hostname; if ($POSIX) { @dirarray = cmd_array("kill -$Signal $Process"); } else { $os->kill($Process); } _logevents("kill -$Signal $Process\n",0); } else { push @remoteargs, "kill"; if (defined($Process)) { push @remoteargs, "-p"; push @remoteargs, "$Process"; } if (defined($Signal)) { push @remoteargs, "-s"; push @remoteargs, "$Signal"; } @dirarray = _clientcall($ServerName, @remoteargs); } return @dirarray; } # # Look at the environment of a running server. # sub do_set { @ARGV = @_; my $ServerName; my %Options; my @envarray; my $key; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { foreach $key (sort keys %ENV) { push @envarray, "$key = $ENV{$key}\n"; } _logevents("set @_\n",0); } else { @envarray = _clientcall($ServerName, "set"); } return "\n @envarray"; } # # General function for reading a file... # sub _read_file_log { # Make this more readable... my $BuildName = shift; my $BuildType = shift; my $LogType = shift; my $LogFile; my $line; my @dirarray; # # Call subroutine to look up the build directory... # my $BuildRoot = _getbuildroot($BuildName); # print "BuildRoot = $BuildRoot\n"; # # If we didn't find a buildroot... # if (!defined($BuildRoot)) { return "no build $BuildName found"; } # # If there is a file we need to pass it's contents back # to the client... # if (($LogType =~ /error/) || ($LogType =~ /remote/)) { if ($LogType =~ /error/) { $LogFile = "$BuildName.$BuildType.$LogType.log"; } else { $LogFile = "$BuildName.$BuildType.sync.log"; } } else { $LogFile = "$BuildName.$LogType.log"; } if (-f "$BuildRoot/$LogFile") { # Get contents of the errorlog... @dirarray = _catfile("$BuildRoot/$LogFile"); foreach $line (@dirarray) { if ($line =~ /File\(s\) up-to-date/) { return " "; } } unshift(@dirarray,"\n"); # Return the array... return @dirarray; } else { # There is no error log... return "no $LogType.log for $BuildName $BuildType found!"; } } # Subroutine to return updates to the build server sub whatsnew { @ARGV = @_; my $ServerName; my @FileArray; my %Options; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { # Get contents of the build.txt file... if ( -f "$dir/updates/$hostname.whatsnew.txt") { @FileArray = _catfile("$dir/updates/$hostname.whatsnew.txt"); _logevents("whatsnew $ServerName\n",0); return @FileArray; } else { _logevents("whatsnew $ServerName.whatsnew.txt\n",1); return "no update file found for $hostname"; } } else { @FileArray = _clientcall($ServerName, "whatsnew"); } return @FileArray; } # # Subroutine to return instructions on running a build locally (if any) # sub instructions { @ARGV = @_; my $ServerName; my $BuildName; my @FileArray; my @argarray; my %Options; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } # Make sure we have a buildname if (!defined($BuildName)) { _logevents("instructions @_: missing buildname\n",1); return display_command_usage("instructions"); } if ($ServerName =~ /^$hostname$/) { # # Get contents of the build.txt file... # if ( -f "$dir/build_docs/$BuildName.txt") { @FileArray = _catfile("$dir/build_docs/$BuildName.txt"); _logevents("instructions $BuildName $ServerName\n",0); } else { _logevents("instructions $BuildName $ServerName\n",1); push @FileArray, "no instructions for $BuildName found!" } } else { push @argarray, "instructions"; push @argarray, "-n"; push @argarray, "$BuildName"; @FileArray = _clientcall($ServerName, @argarray); } return @FileArray; } # Subroutine to return the contents of the synclog... sub getsync_log { @ARGV = @_; my $ServerName; # Make this more readable... my $BuildName; my %Options; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; my $BuildRoot = _getbuildroot($BuildName); my $rserver; my $rclient; my $file; my $ext; my @FileArray; my @RFileArray; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { # # Make sure we have a buildname # if (!defined($BuildName)) { _logevents("synclog @_: missing buildname\n",1); return display_command_usage("synclog"); } @FileArray = _read_file_log($BuildName, "sync", "sync"); _logevents("synclog $BuildName.sync.log\n",0); } else { @FileArray = _clientcall($ServerName, "synclog", "-n", "$BuildName"); } return "@FileArray @RFileArray"; } # Subroutine to retturn the contents of the errorlog (if any) sub geterror_log { @ARGV = @_; # Make this more readable... my $BuildName; my $BuildType; my $ServerName; my %Options; my @argarray; getopts('S:n:t:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $BuildType = $Options{t}; my @FileArray; # Make sure we have a buildname if (!defined($BuildName)) { _logevents("errorlog @_: missing buildname\n",1); return display_command_usage("errorlog"); } # Make sure we have a buildtype if (!defined($BuildType)) { _logevents("errorlog @_: missing buildtype\n",1); return display_command_usage("errorlog"); } if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { @FileArray = _read_file_log($BuildName, $BuildType, "error"); } else { push @argarray, "errorlog"; push @argarray, "-n"; push @argarray, "$BuildName"; push @argarray, "-t"; push @argarray, "$BuildType"; push @argarray, "error"; @FileArray = _clientcall($ServerName, @argarray); } _logevents("errorlog $ServerName $BuildName $BuildType\n",0); return @FileArray; } sub do_joblog { @ARGV = @_; my $ServerName; my $BuildName; my @JobInfo; my %Options; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; if (!defined($BuildName)) { _logevents("joblog: missing buildname\n",1); return display_command_usage("joblog"); } if (!defined($ServerName)) { $ServerName = $hostname; } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("joblog: $msghash{2} $BuildName $ServerName\n",1); return $msghash{2}; } if ($ServerName =~ /^$hostname$/) { _logevents("joblog: $BuildName $ServerName\n",0); $sqlquery = "select message from joblog where ". "binary server=\"$ServerName\" and ". "binary title=\"$BuildName\" ". "order by step"; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray == 0) { return "No joblog for $BuildName on $ServerName"; } foreach $line (@sqlarray) { push @JobInfo, "$line\n"; } unshift(@JobInfo,"\n"); } else { @JobInfo = _clientcall($ServerName, "-n", "$BuildName"); } return @JobInfo; } sub debuglog { @ARGV = @_; my $BuildName; my $ServerName; my %Options; my @FileArray; getopts('S:n:', \%Options); $BuildName = $Options{n}; $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { @FileArray = _catfile("$Mtmpdir/$BuildName.log"); unshift(@FileArray, "\n"); } else { @FileArray = _clientcall($ServerName, "debuglog", "-n", "$BuildName"); } _logevents("debuglog $ServerName $BuildName\n",0); return @FileArray; } sub getbuild_log { @ARGV = @_; my $BuildName; my $BuildType; my $ServerName; my %Options; my @FileArray; my @argarray; getopts('S:n:t:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $BuildType = $Options{t}; if (!defined($BuildName)) { _logevents("buildlog @_: missing buildname\n",1); return display_command_usage("buildlog"); } if (!defined($BuildType)) { _logevents("buildlog @_: missing buildtype\n",1); return display_command_usage("buildlog"); } if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { @FileArray = _read_file_log($BuildName, $BuildType, $BuildType); } else { push @argarray, "buildlog"; push @argarray, "-n"; push @argarray, "$BuildName"; push @argarray, "-t"; push @argarray, "$BuildType"; @FileArray = _clientcall($ServerName, @argarray); } _logevents("buildlog $BuildName $BuildType $ServerName\n",0); return @FileArray; } sub jobstate { @ARGV = @_; my %Options; my $c=0; my @locks; my @jobArray; my @JOBArray; my $ServerName; $JOBArray[$c] = "\n"; $c++; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; # stuff found by strict my $lock; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if (_serverup($ServerName)) { # Grab a list of jobs from the buildtable... @jobArray = _getjoblist($ServerName); # For each entry returned, check to see if a lock exists. foreach $lock (@jobArray) { $sqlquery = "select semaphores.message from semaphores left ". "join configuration on semaphores.title=". "configuration.title where semaphores.state=\"1\" ". "and binary semaphores.title=\"$lock\" and ". "configuration.state=\"0\" and binary ". "configuration.server=\"$ServerName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { foreach $line (@sqlarray) { $JOBArray[$c] = $line; $locks[$c] = "$JOBArray[$c]\n"; } $sqlquery = "select message from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$lock\" and state=\"2\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { chomp $JOBArray[$c]; $locks[$c] = "$JOBArray[$c] - status change pending!\n"; } $c++; } } if (defined($locks[$c-1])) { chomp $locks[$c-1]; } _logevents("jobstate\n",0); if ($c == 1) { return "buildserver $ServerName is currently idle"; } else { return @locks; } } else { return "buildserver $ServerName is currently down"; _logevents("jobstate $ServerName\n",0); } } sub clone { @ARGV = @_; my $oldjob; my $newjob; my $ServerName; my %Options; my $ret; my $sqlquery; my @sqlarray; my @sqlsubmit; my $newpath; my $oldpath; my $changestring; my $key; my $Is; my $Os; my $jobdir = $config->JOBDIR; my %scripts = ( "retail", $config->RETAIL, "debug", $config->DEBUG, "onfail", $config->ONFAIL, "prebuild", $config->PREBUILD, "postbuild", $config->POSTBUILD ); getopts('S:n:c:', \%Options); $ServerName = $Options{S}; $oldjob = $Options{n}; $newjob = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($oldjob)) { _logevents("clone: $msghash{9}\n",1); return display_command_usage("clone"); } if (!defined($newjob)) { _logevents("clone: $msghash{9}\n",1); return display_command_usage("clone"); } if (!_ValidJob($oldjob,$ServerName,0)) { _logevents("clone: $msghash{2} $oldjob\n",1); return "Unknown job $oldjob"; } if (_ValidJob($newjob,$hostname,0)) { _logevents("clone: $msghash{17} $newjob\n",1); return "$newjob already exists"; } $sqlquery = "select * from configuration where binary title=\"$oldjob\" ". "and binary server=\"$ServerName\""; print "sqlquery = $sqlquery\n"; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); $changestring = $sqlarray[0]; $changestring =~ s/$oldjob/$newjob/g; $changestring =~ s/$ServerName/$hostname/g; @sqlsubmit = split(/,/,$changestring); print "sqlquery1 = $sqlquery\n"; if (( $ret = $os->run_sql_submit("configuration", @sqlsubmit)) == 0) { _logevents("clone $oldjob $newjob: SQL failed\n",1); return "Failed to write configuration info to SQL server"; } # # Create newpath / oldpath for generation of build scripts # $newpath = $config->BSR; $newpath .= "/jobs/$newjob"; $oldpath = $config->BSR; $oldpath .= "/jobs/$oldjob"; if (! -d "$newpath") { mkpath("$newpath", 0, 0755); } if (-d "$oldpath") { foreach $key (keys %scripts) { $Is = $oldpath."/".$scripts{$key}; $Os = $newpath."/".$scripts{$key}; _copycontents($Is, $Os, $oldjob, $newjob); } } # # Make output directory for new job # if (! -d "$jobdir/$newjob") { mkpath("$jobdir/$newjob", 0, 0755); } $Is = $config->BSR; $Is .= "/build_docs/$oldjob.txt"; $Os = $config->BSR; $Os .= "/build_docs/$newjob.txt"; _copycontents($Is, $Os, $oldjob, $newjob); $Is = $config->BSR; $Is .= "/config/$oldjob.errors"; $Os = $config->BSR; $Os .= "/config/$newjob.errors"; _copycontents($Is, $Os, $oldjob, $newjob); _logevents("clone $oldjob $ServerName $newjob $hostname\n",0); return "job $newjob on $hostname cloned from $oldjob on $ServerName"; } sub _copycontents { my $in = shift; my $out = shift; my $search = shift; my $replace = shift; if (-f $in) { open (IS, "<$in"); open (OS, ">$out"); while () { my $newline = $_; $newline =~ s/$search/$replace/g; print OS "$newline"; } close(IS); close(OS); } return 0; } sub lock_build { @ARGV = @_; my $lock; my $myret; my $ServerName; my %Options; # # SQL Stuff... # my $sqlquery; my @sqlarray; my @sqlsubmit; my @empty; my @jobarray; my $line; my $ret; my @return; my $itsnow = $os->_get_hosttime(); # my $itsnow = time(); getopts('S:n:', \%Options); $ServerName = $Options{S}; $lock = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($lock)) { _logevents("disable: $msghash{9}\n",1); return display_command_usage("disable"); } if ($ServerName =~ /^$hostname$/) { if ($lock !~ /^all$/ic) { if (!_ValidJob($lock,$ServerName,0)) { _logevents("disable: $msghash{2} $lock\n",1); return "Unknown job $lock on $ServerName"; } } if ($lock =~ /^all$/ic) { @jobarray = _getactivejobs($ServerName); } else { push @jobarray, $lock; } foreach $line (@jobarray) { @sqlsubmit = @empty; @sqlarray = @empty; $sqlquery = "select state from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$line\" and state=\"1\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray == 0) { push @sqlsubmit, "$ServerName"; push @sqlsubmit, "$line"; push @sqlsubmit, "=[$line build job disabled by $peeraddress="; push @sqlsubmit, "$itsnow"; push @sqlsubmit, "1"; if (($ret = $os->run_sql_submit("semaphores", @sqlsubmit)) == 0) { $myret .= "SQL failed"; _logevents("disable: SQL failed for $line\n",1); } else { $myret .= "job $line disabled"; _logevents("disable: $line\n",0); } } else { $sqlquery = "select state from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$line\" and state=\"2\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray == 0) { push @sqlsubmit, "$ServerName"; push @sqlsubmit, "$line"; push @sqlsubmit, "=[$line build job disabled by ". "$peeraddress="; push @sqlsubmit, "$itsnow"; push @sqlsubmit, "2"; if (($ret = $os->run_sql_submit("semaphores", @sqlsubmit)) == 0) { $myret .= "SQL pending failed"; _logevents("disable: $line SQL pending failed\n",1); } else { $myret .= "$line lock pending"; _logevents("$msghash{15}: $line\n",0); } } } } push @return, $msghash{0}; } else { @return = _clientcall($ServerName, "disable", "-n", "$lock"); } return @return; } sub _getactivejobs { my $ServerName = shift; my $sqlquery; my @sqlarray; $sqlquery = "select title from configuration where binary server". "=\"$ServerName\" and state=\"0\""; @sqlarray = $os->run_sql_query($sqlquery,","); return @sqlarray; } sub unlock_build { @ARGV = @_; my $job; my $myret; my @return; my $ServerName; my $force; my $kill; my @jobarray; my @argarray; my %Options; # # SQL Stuff... # my $sqlquery; my @sqlarray; my @empty; my $line; my $ret; getopts('S:n:fk', \%Options); $ServerName = $Options{S}; $job = $Options{n}; $force = $Options{f}; $kill = $Options{k}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($job)) { _logevents("enable\n",1); return display_command_usage("enable"); } if ($ServerName =~ /^$hostname/) { if ($job =~ /^all$/ic) { @jobarray = _getactivejobs($ServerName); } else { push @jobarray, $job; } foreach $line (@jobarray) { @sqlarray = @empty; $sqlquery = "select state from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$line\" and state=\"1\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray == 0) { $myret .= "$reqtime $peeraddress $msghash{0}: enable $job"; _logevents("$myret\n",0); } else { $sqlquery = "delete from semaphores where ". "server=\"$ServerName\" and title=\"$line\""; $ret = $os->run_sql_remove("$sqlquery"); if (!$ret) { $myret .= "$reqtime $peeraddress SQL failed: enable ". "$line\n"; _logevents("$myret",1); } else { $myret .= "$reqtime $peeraddress $msghash{2}: enable ". "$line\n"; _logevents("$myret",1); } if (!$force) { $isinternal = 1; recover("-n", "$line"); $isinternal = 0 } if ($kill && $force) { my $id; $sqlquery = "select pid from proctree where binary ". "title=\"$line\" and binary server=". "\"$ServerName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray == 0) { _logevents("$reqtime $peeraddress no pid to kill",1); } else { $isinternal = 1; foreach $id (@sqlarray) { do_kill("-p", "$id", "-s", "9"); } $isinternal = 0 } } } } push @return, $msghash{0}; } else { push @argarray, "enable"; push @argarray, "-n"; push @argarray, "$job"; if ($force) { push @argarray, "-f"; } if ($kill && $force) { push @argarray, "-k"; } @return = _clientcall($ServerName, @argarray); } return @return; } sub get_fails { @ARGV = @_; my @BLDArray; my @TMPArray; my @argarray; my $result; my $elements; my $ret; my $ServerName; my $jobName; my $showlast; my %Options; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; getopts('S:n:l:', \%Options); $ServerName = $Options{S}; $jobName = $Options{n}; $showlast = $Options{l}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($jobName)) { _logevents("incomplete: $msghash{2}\n",1); return display_command_usage("incomplete"); } if (!_ValidJob($jobName,$ServerName,0)) { _logevents("incomplete $jobName: $msghash{2}\n",1); return "Unknown job $jobName"; } if ($ServerName =~ /^$hostname/) { $sqlquery = "select job from jobs where binary ". "server=\"$ServerName\" and binary ". "title=\"$jobName\" and status=\"2\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { push @BLDArray, "\n"; } foreach $line (@sqlarray) { chomp $line; push @BLDArray, "$line\n"; } my $elements = @BLDArray; if ($elements > 0) { if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@BLDArray, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @BLDArray; } } } else { push @BLDArray, "no build failures for $jobName on $ServerName"; } _logevents("incomplete $jobName $ServerName\n",0); } else { push @argarray, "-n"; push @argarray, "$jobName"; if (defined($showlast)) { push @argarray, "-l"; push @argarray, "$showlast"; } @BLDArray = _clientcall("$ServerName", "incomplete", @argarray); } return @BLDArray; } sub runstats { @ARGV = @_; my %Options; my $ServerName; my $BuildName; my $ShowLast; my $AvgOnly; my $whoraw; my $recno = 0; my $num; my $start; my $end; my $StartTime; my $EndTime; my $elapsed; my $avgtime; my $avginc = 0; my $avg; my $raw; my $startrec; my $printline; my $result; my $lastup; my $lastgoodelapsed = 0; my $bshowfailkey = 0; my $bshowbtestkey = 0; my $bshowgtestkey = 0; my @ReturnArray; my @StatArray; my $ret; getopts('S:n:l:ar', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $ShowLast = $Options{l}; $AvgOnly = $Options{a}; $whoraw = $Options{r}; # # For use with mysql # my $sqlquery; my @sqlarray; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("runstats: $msghash{2}\n",1); return "missing job name"; } if (($ret = _ValidJob($BuildName,$ServerName,0)) == 0) { _logevents("runstats: $msghash{2} $BuildName\n",1); return "undefined job $BuildName on $ServerName"; } if (defined($AvgOnly)) { $avg = 1; } if (defined($whoraw)) { $raw = 1; } if ($ServerName =~ /^$hostname$/) { # # Just to make this more readable # $sqlquery = "select job, start, end, status, info ". "from jobs where binary server=\"$ServerName\" ". "and binary title=\"$BuildName\" order by start"; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); foreach $sqlquery (@sqlarray) { push @StatArray, $sqlquery; } my $numrecs = @StatArray; if ($numrecs < 1) { _logevents("runstats: $BuildName no stats\n",1); @ReturnArray[0] = "no stats for $BuildName on $ServerName"; return @ReturnArray; } if (defined($ShowLast)) { if ($ShowLast < 1) { $ShowLast = $ret; } if ($numrecs > $ShowLast) { $startrec = $numrecs - $ShowLast; } else { $startrec = 0; } } else { $ShowLast = $ret; } if ($numrecs > $ShowLast) { $startrec = $numrecs - $ShowLast; } else { $startrec = 0; } push @ReturnArray, "\n"; if ((!defined($avg)) && (!defined($raw))) { $printline = sprintf("%-20s %-22s %-22s %-8s\n\n", "Job", "Start", "Finish", "Elapsed"); push @ReturnArray, $printline; } for (; $startrec < $numrecs; $startrec++) { ($num, $start, $end, $result, $lastup) = split(/,/, $StatArray[$startrec]); $StartTime = _gen_local_time_string($start); $EndTime = _gen_local_time_string($end); $elapsed = _format_elapsed_time($end - $start); if ($result == 0 || $result == 1) { $avginc += ($end - $start); } if ((!defined($avg)) && (!defined($raw))) { if ($result == 0) { $printline = sprintf("%-20s %-22s %-22s %-8s\n", $num, $StartTime, $EndTime, $elapsed); } elsif ($result == 1) { $printline = sprintf("%-20s %-22s %-22s %-8s*\n", $num, $StartTime, $EndTime, $elapsed); $bshowbtestkey = 1; } elsif ($result == 2) { $printline = sprintf("%-20s %-22s %-22s %-8s**\n", $num, $StartTime, $EndTime, $elapsed); $bshowfailkey = 1; } elsif ($result == 3) { $printline = sprintf("%-20s %-22s %-22s %-8s***\n", $num, $StartTime, $EndTime, $elapsed); $bshowgtestkey = 1; } push @ReturnArray, $printline; } if ($result == 0 || $result == 1) { $recno++; } if ((defined($raw)) && (!defined($avg))) { if ($result == 0 || $result == 1) { if (!defined ($lastup)) { $printline = sprintf("%s,%10d,%10d,%d,%d,%d\n", $num, $start, $end, $end-$start, $avginc/$recno, $result); } else { $printline = sprintf("%s,%10d,%10d,%d,%d,%d,%s\n", $num, $start, $end, $end-$start, $avginc/$recno, $result, $lastup); } $lastgoodelapsed = $avginc/$recno; push @ReturnArray, $printline; } else { if (!defined ($lastup)) { $printline = sprintf("%s,%10d,%10d,%d,%d,%d\n", $num, $start, $end, $end-$start, $lastgoodelapsed, $result); } else { $printline = sprintf("%s,%10d,%10d,%d,%d,%d,%s\n", $num, $start, $end, $end-$start, $lastgoodelapsed, $result, $lastup); } push @ReturnArray, $printline; } } } if ($recno > 0) { $avgtime = _format_elapsed_time($avginc/$recno); } else { $avgtime = 0; } if (!defined($avg)) { push @ReturnArray, "\n"; } if ((defined($avg)) && (defined($raw))) { if ($recno > 0 ) { $printline = sprintf("%d", $avginc/$recno); } else { $printline = sprintf("%d", $recno); } push @ReturnArray, $printline; } if (!defined($raw)) { if ($bshowbtestkey) { push @ReturnArray, "* build failed test\n"; } if ($bshowfailkey) { push @ReturnArray, "** build failed to compile\n"; } if ($bshowgtestkey) { push @ReturnArray, "*** build completed testing\n"; } push @ReturnArray, "Average: $avgtime\n"; } _logevents("runstats: $BuildName\n",0); } else { my @argarray; push @argarray, "runstats"; push @argarray, "-n"; push @argarray, "$BuildName"; if (defined($ShowLast)) { push @argarray, "-l"; push @argarray, "$ShowLast"; } if ($AvgOnly) { $isexternal = 1; push @argarray, "-a"; } if ($whoraw) { $isexternal = 1; push @argarray, "-r"; } @ReturnArray = _clientcall($ServerName, @argarray); $isexternal = 0; } return @ReturnArray; } sub promote { @ARGV = @_; my $ServerName; my $BuildName; my $JobNo; my $comment; my %Options; my @argarray; my @retarray; my $commentline; my $fullcomment; my $delim = $config->SMTPDELIM; my $args; my $ret; my $pid; my $osig; my $sig; my $lreqtime = $reqtime; my $lpeeraddress = $peeraddress; $lreqtime =~ s/\[//g; $lpeeraddress =~ s/\]//g; # # For SQL... # my @SQLArray; my $sqlret; my $sqlquery; my $sqlline; my @queryarray; # # Mail configuration # my $ms = $config->SMTP; my $admin = $config->ADMIN; my $alternate = $config->ALTERNATE; my %mail; my %tohash; my $hashkey; # # Root dirs for source and targets as defined in buildconf.pm # my $source = $config->JOBDIR; my $target = $config->PROMOTION; getopts('S:n:j:c:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $JobNo = $Options{j}; $comment = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } # # Make sure there were args sent... # if (!defined($BuildName)) { _logevents("promote: $msghash{2}\n",1); return "missing job name"; } # # Make sure there was a job number sent # if (!defined($JobNo)) { _logevents("promote: $msghash{9}\n",1); return "missing job number"; } # # Make sure this is a vaild job # if (!_ValidJob($BuildName,$hostname,0)) { _logevents("promote: $msghash{2} $BuildName\n",1); return "undefined job $BuildName"; } # # Make sure there's a comment for the promotion # if (!defined($comment)) { _logevents("promote: $msghash{9} $BuildName\n",1); return "comment required for promote command"; } if ($ServerName =~ /^$hostname$/) { # # Make sure this job exists # if (! -d "$source/$BuildName/$JobNo") { _logevents("promote: $msghash{18} $BuildName\n",1); return "$BuildName $JobNo does not exist"; } # # See if the job has already been promoted # if (-d "$target/$BuildName/$JobNo") { _logevents("promote: $msghash{19} $BuildName $JobNo\n",1); return "$BuildName $JobNo already promoted"; } else { my $tomake = "$target/$BuildName/$JobNo"; $tomake =~ s/\\/\//g; mkpath("$tomake", 0, 0755); if (! -d "$target/$BuildName/$JobNo") { _logevents("promote: $msghash{20} $tomake\n",1); return "failed to create target $target/$BuildName/$JobNo"; } } # # This sends out mail even before it completes. # if ($POSIX) { # # Call forkprocess and return with pid # $pid = $os->forkprocess( "cp -r $source/$BuildName/$JobNo/* ". "$target/$BuildName/$JobNo", 0, 0); } else { # # Spawn a separate process so that the buildserver can # continue on... # $os->wincopyfiles("$source/$BuildName/$JobNo", "$target/$BuildName/$JobNo"); } $mail{"Smtp"} = $ms; $mail{"From"} = "Build Promotion <$admin>"; # # Gather up address and put them into a hash to eliminate # duplicate entries. # $sqlquery = "select address from subscription where binary ". "server=\"$hostname\" and binary ". "title=\"$BuildName\""; @queryarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $sqlline(@queryarray) { chomp $sqlline; $tohash{"$sqlline"} = ""; } $target =~ s/\\/\//g; $tohash{"$admin"} = ""; $mail{Subject} = "*$BuildName $JobNo promoted for testing*"; $mail{Message} = "$BuildName $JobNo was promoted to ". "$target/$BuildName/$JobNo and is available ". "for testing\n"; foreach $hashkey (keys %tohash) { $mail{To} .= "$hashkey$delim"; } sendmail %mail; push @SQLArray, "$hostname"; push @SQLArray, "$BuildName"; push @SQLArray, "$JobNo"; push @SQLArray, "$lreqtime"; push @SQLArray, "$lpeeraddress"; push @SQLArray, "$comment"; if (($ret = $os->run_sql_submit("promotion", @SQLArray)) == 0) { _logevents("promote: SQL failed $BuildName $JobNo\n",0); return "failed to add promoted job to SQL server"; } } else { push @argarray, "promote"; push @argarray, "-n"; push @argarray, "$BuildName"; push @argarray, "-j"; push @argarray, "$JobNo"; push @argarray, "-c"; push @argarray, "\"$comment\""; @retarray = _clientcall($ServerName, @argarray); return @retarray; } } # # Create a symlink to the latest tested build # sub passed { @ARGV = @_; my $BuildName; my $JobNo; my $comments; my $ret; my @cmdarray; my %Options; getopts('n:j:c:', \%Options); $BuildName = $Options{n}; $JobNo = $Options{j}; $comments = $Options{c}; if (!defined($BuildName)) { _logevents("passed: $msghash{2}\n",1); return "missing job name"; } if (!defined($JobNo)) { _logevents("passed: $msghash{9}\n",1); return "missing job number"; } if (!_ValidJob($BuildName,$hostname,0)) { _logevents("passed: $msghash{2} $BuildName\n",1); return "undefined job $BuildName"; } if (! -d "$Moutdir/$BuildName/$JobNo") { _logevents("passed: $msghash{18} $BuildName $JobNo\n",1); return "$BuildName $JobNo does not exist"; } # # If there's a symlink, unlink it # if (-s "$Moutdir/$BuildName.tested") { print "$Moutdir/$BuildName.tested exists\n"; unlink("$Moutdir/$BuildName.tested/.keep") || warn "Can't unlink file: $?"; unlink("$Moutdir/$BuildName.tested") || warn "Can't unlink file: $?"; } # # Create a new symlink # symlink("$Moutdir/$BuildName/$JobNo", "$Moutdir/$BuildName.tested") || warn "Can't create symlink: $?"; # # Arg list for keep # push @cmdarray, "-n"; push @cmdarray, "$BuildName"; push @cmdarray, "-j"; push @cmdarray, "$JobNo"; if (defined($comments)) { push @cmdarray, "-c"; push @cmdarray, "$comments"; } # # Run the keep command # $isinternal = 1; keep(@cmdarray); $isinternal = 0; # # Create a file to be used by external scripts if necessary # open (KEEP, ">$Moutdir/.$BuildName.lasttested"); print KEEP $JobNo; close(KEEP); # # Remove the default 'NOT TESTED' file then # create a 'TEST PASSED' file # if (-f "$Moutdir/$BuildName/$JobNo/$nottested") { unlink ("$nottested"); open (TESTED, ">$Moutdir/$BuildName/$JobNo/$tested"); close(TESTED); } else { open (TESTED, ">$Moutdir/$BuildName/$JobNo/$tested"); close(TESTED); } _logevents("passed: $BuildName $JobNo\n",0); return $msghash{0}; } sub keep { @ARGV = @_; my $ServerName; my $BuildName; my $JobNo; my $comments; my @rmtargs; my @cmdreturn; my %Options; my $ret; getopts('S:n:j:c:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $JobNo = $Options{j}; $comments = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("keep: $msghash{2}\n",1); return "missing job name"; } if (!defined($JobNo)) { _logevents("keep: $msghash{9}\n",1); return "missing job number"; } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("keep: $msghash{2} $BuildName\n",1); return "undefined job $BuildName"; } if ($ServerName =~ /^$hostname$/) { if (! -d "$Moutdir/$BuildName/$JobNo") { _logevents("keep: $msghash{18} $BuildName $JobNo $ServerName\n",1); return "$BuildName $JobNo does not exist"; } open (KEEP, ">$Moutdir/$BuildName/$JobNo/.keep"); print KEEP "$comments\n"; close(KEEP); push @cmdreturn, $msghash{0}; } else { push @rmtargs, "keep"; push @rmtargs, "-n"; push @rmtargs, "$BuildName"; push @rmtargs, "-j"; push @rmtargs, "$JobNo"; if (defined($comments)) { push @rmtargs, "-c"; push @rmtargs, "$comments"; } @cmdreturn = _clientcall($ServerName, @rmtargs); } _logevents("keep: $BuildName $JobNo $ServerName\n",0); return @cmdreturn; } sub free { @ARGV = @_; my $ServerName; my $BuildName; my $JobNo; my %Options; my $ret; my @argarray; my @callarray; getopts('S:n:j:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $JobNo = $Options{j}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("free: $msghash{2}\n",1); return "missing job name"; } if (!defined($JobNo)) { _logevents("free: $msghash{9}\n",1); return "missing job number"; } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("free: $msghash{2} $BuildName\n",1); return "undefined job $BuildName"; } if ($ServerName =~ /^$hostname$/) { if (! -d "$Moutdir/$BuildName/$JobNo") { _logevents("free: $msghash{18} $BuildName $JobNo\n",1); return "$BuildName $JobNo on $ServerName does not exist"; } if (-f "$Moutdir/$BuildName/$JobNo/.keep") { unlink("$Moutdir/$BuildName/$JobNo/.keep"); } _logevents("free: $ServerName $BuildName $JobNo\n",0); return $msghash{0}; } else { push @argarray, "free"; push @argarray, "-n"; push @argarray, "$BuildName"; push @argarray, "-j"; push @argarray, "$JobNo"; @callarray = _clientcall($ServerName, @argarray); } _logevents("free: $ServerName $BuildName $JobNo\n",0); return @callarray; } sub display_command_usage { my $request = shift; my $help; _logevents("help $request\n",0); if (! defined $request) { $help = "help with what?"; } else { $help = $helptable{$request}; if (!defined($help)) { $help = $msghash{23}; } } return $help; } sub display_commands { @ARGV = @_; my $blong = 0; my $html = 0; my $c = 0; my @sc; my $i; my $left = 0; my $entries; my $leftside; my $rightside; my $cmdret = 0; my @returnArray; my @argarray; # stuff found by strict my $key; my $ServerName; my %Options; getopts('S:lw', \%Options); $ServerName = $Options{S}; $blong = $Options{l}; $html = $Options{w}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname/) { if (!$blong) { $sc[$c] = "\n"; $c++; } else { push @returnArray, "\n"; } foreach $key (sort keys %supportedcmds) { if (!$blong) { $sc[$c] = "$key\n"; $c++; } else { my $sr = $helptable{$key}; if ($html) { $sr =~ s/Usage/\$key\<\/b\>/g; } else { $sr =~ s/Usage/$key/g; } push @returnArray, $sr; } } if (!$blong) { $entries = @sc; $returnArray[$cmdret++] = "\n"; for ($i = 0; $i < $entries; $i++) { chomp $sc[$i]; if ($sc[$i] !~ /^$/) { if ($left == 0) { $leftside = $sc[$i]; $left++; } else { $rightside = $sc[$i]; $left = 0; $returnArray[$cmdret++] = sprintf "%-15s %-15s\n", $leftside, $rightside; } } } if ($left == 1) { sprintf "%-15s\n", $sc[$i-1]; $returnArray[$cmdret] = sprintf "%-15s\n", $leftside; } } _logevents("commands\n",0); } else { if (defined($blong)) { push @argarray, "-l"; } if (defined($html)) { push @argarray, "-w"; } @returnArray = _clientcall($ServerName, "commands", @argarray); } return @returnArray; } sub whosauthorized { @ARGV = @_; my @Contents; # # SQL stuff... # my @sqlarray; my $sqlquery; my $line; my $ServerName; my %Options; getopts('S:',\%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { push @Contents, "\n"; push @Contents, "Computers authorized to control builds:\n\n"; $sqlquery = "select machine from authtable where ". "binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { push @Contents, "\t$line\n"; } push @Contents, "\n"; } else { @Contents = _clientcall($ServerName, "authorized"); } _logevents("authorized $ServerName\n",0); return @Contents; } sub authorize { @ARGV = @_; my $compname; my $ServerName; my $ret; my %Options; my $sqlquery; my @svrarray; my @retarray; getopts('S:c:', \%Options); $ServerName = $Options{S}; $compname = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname/) { $sqlquery = "select server from buildservers where binary ". "server=\"$ServerName\""; @svrarray = $os->run_sql_query($sqlquery, ";"); $ret = @svrarray; if (!$ret) { _logevents("authorize $ServerName: $msghash{22}\n", 1); return "authorize $ServerName: $msghash{22}"; } # # SQL Stuff... # my @sqlarray; if (!defined($compname)) { _logevents("authorize: $msghash{9}\n",1); return display_command_usage("authorize"); } if (($ret = IsEntry($compname)) == 1) { _logevents("authorize $compname $ServerName: $msghash{12}\n",1); return "$msghash{12}"; } push @sqlarray, $ServerName; push @sqlarray, $compname; if (($ret = $os->run_sql_submit("authtable", @sqlarray)) == 0) { _logevents("authorize $compname $ServerName: sql failed\n", 1); } _logevents("$compname authorized for build control\n",0); return "$compname authorized for buildcontrol"; } else { @retarray = _clientcall($ServerName, "authorize", "-c", "$compname"); } return @retarray; } sub unauthorize { @ARGV = @_; my $ServerName; my $compname; my $ret; my %Options; my @retarray; # # SQL Stuff... # my $sqlquery; getopts('S:c:', \%Options); $ServerName = $Options{S}; $compname = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } if ((!defined($compname))) { _logevents("unauthorize: $msghash{9}\n",1); return display_command_usage("unauthorize"); } if ($ServerName =~ /^$hostname$/) { if (($ret = IsEntry($compname)) == 0) { _logevents("unauthorize $compname: $msghash{12}\n",1); return "$msghash{12}"; } $sqlquery = "delete from authtable where server=\"$hostname\" ". "and machine=\"$compname\""; if (($ret = $os->run_sql_remove("$sqlquery")) == 0) { _logevents("unauthorize $compname: sql failed", 1); return "SQL failed when trying to remove $compname from authtable"; } _logevents("$compname unauthorized from $hostname build control\n",0); return "$compname unauthorized from build control on $hostname"; } else { @retarray = _clientcall($ServerName, "unauthorize", "-c", "$compname"); return @retarray; } } sub subscribers { @ARGV = @_; my $BuildName; my $ServerName; my @Contents; my $ret; # # SQL Stuff... # my $sqlquery; my @sqlarray; my $line; my %Options; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("subscribers: $msghash{9}\n",1); return display_command_usage("subscribers"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("subscribers $BuildName: $msghash{2}\n",1); return "$msghash{2}"; } push @Contents, "\n"; push @Contents, "Subscribers to $BuildName on $ServerName:\n\n"; $sqlquery = "select address from subscription where ". "binary server=\"$ServerName\" and binary ". "title=\"$BuildName\" order by address"; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { push @Contents, "\t$line\n"; } push @Contents, "\n"; _logevents("subscribers $BuildName on $ServerName\n",0); return @Contents; } sub unsubscribe { @ARGV = @_; my $ServerName; my $BuildName; my $EmailAddr; my $ret; my %Options; # # SQL Stuff... # my $sqlstring; my @Contents; getopts('S:n:e:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $EmailAddr = $Options{e}; if (!defined($ServerName)) { $ServerName = $hostname; } if ((!defined($EmailAddr)) || (!defined($BuildName))) { _logevents("unsubscribe: $msghash{9}\n",1); return display_command_usage("unsubscribe"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("unsubscribe $ServerName $BuildName $msghash{2}\n",1); return "$msghash{2}"; } if (($ret = OldAddress($ServerName, $BuildName,$EmailAddr)) == 0) { _logevents("unsubscribe $ServerName $BuildName $EmailAddr: ". "$msghash{13}\n",1); return "$msghash{13}"; } $sqlstring = "delete from subscription where server=\"$ServerName\" ". "and title=\"$BuildName\" and address=\"$EmailAddr\""; if (($ret = $os->run_sql_remove("$sqlstring")) == 0) { _logevents("unsubscribe $ServerName $BuildName $EmailAddr: ". "SQL failed\n",1); return "SQL failed removing $EmailAddr from $BuildName"; } _logevents("$EmailAddr unsubscribed from $ServerName $BuildName\n",0); return "$EmailAddr unsubscribed from $BuildName on $ServerName"; } sub subscribe { @ARGV = @_; my $ServerName; my $BuildName; my $EmailAddr; my %Options; my $ret; my %SubscribeHash; # # SQL Stuff... # my @SQLArray; getopts('S:n:e:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $EmailAddr = $Options{e}; if (!defined($ServerName)) { $ServerName = $hostname; } if ((!defined($EmailAddr)) || (!defined($BuildName))) { _logevents("subscribe: $msghash{9}\n",1); return display_command_usage("subscribe"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("subscribe $BuildName: $msghash{2}\n",1); return "$msghash{2}"; } if (($ret = OldAddress($ServerName, $BuildName,$EmailAddr)) == 1) { _logevents("subscribe $ServerName $BuildName $EmailAddr: ". "$msghash{12}\n",1); return "$msghash{12}"; } push @SQLArray, "$ServerName"; push @SQLArray, "$BuildName"; push @SQLArray, "$EmailAddr"; if (( $ret = $os->run_sql_submit("subscription", @SQLArray)) == 0) { _logevents("subscribe $ServerName $BuildName $EmailAddr: ". "SQL failed\n",1); return "Failed to write subscription info to SQL server"; } _logevents("$EmailAddr subscribing to $ServerName $BuildName\n",0); return "$EmailAddr subscribed to $BuildName on $ServerName"; } sub elapsed { @ARGV = @_; my $now; my $difference; my $seconds; my $minutes; my $hours; my $days; my $weeks; my $raw = 0; my $BuildName; my $rawarg; my $ServerName; my @TimeArray; my @GetRawNumbers; my $average; my $j; my $s; my $f, my $e; my $paverage; my $running = 0; my $entry; my $finishline; my $new = 0; my $intsethere = 0; my @contents; my @state; my @argarray; my @return; my @info; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $sqlline; my $sqlret; my %Options; # stuff found by strict my $printline; my $ret; getopts('S:n:r', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $rawarg = $Options{r}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($rawarg) { $raw = 1; } if (!defined($BuildName)) { _logevents("elapsed: $msghash{9}\n",1); return display_command_usage("elapsed"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("elapsed $BuildName: $msghash{2}\n",1); return "invalid job: $BuildName"; } if ($ServerName =~ /^$hostname$/) { _logevents("elapsed $BuildName\n",0); $sqlquery = "select message from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$BuildName\" and state=\"1\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { if ($sqlarray[0] !~ /build job disabled/) { $running = 1; @info = split(/ /, $sqlarray[0]); } } if ($running == 1) { $sqlquery = "select time from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$BuildName\" and state=\"1\""; @TimeArray = $os->run_sql_query("$sqlquery", ";", 0); $now = $os->_get_hosttime(); # $now = time(); if ($isinternal == 0) { $isinternal = 1; $intsethere = 1; } #@GetRawNumbers = runstats("-n","$BuildName","-l",10,"-r"); #foreach $entry (@GetRawNumbers) { # chomp $entry; # ($j,$s,$f,$e,$average) = split(/,/,$entry); # if (defined($average)) { # $paverage = $average; # } #} $paverage = $os->_get_average($ServerName, $BuildName); $difference = $now - $TimeArray[0]; if (defined($paverage)) { if ($paverage > $difference) { $finishline = _format_elapsed_time($paverage-$difference); } else { $finishline = sprintf("may be overdue"); } } else { $new = 1; $finishline = sprintf("no job data, may be a new job"); } if ($raw != 1) { $seconds = $difference % 60; $difference = ($difference - $seconds) / 60; $minutes = $difference % 60; $difference = ($difference - $minutes) / 60; $hours = $difference % 24; $difference = ($difference - $hours) / 24; $days = $difference % 7; $weeks = ($difference - $days) / 7; if ($new == 0) { $printline = sprintf("%s: %02d:%02d:%02d running, ". "%s remaining", $BuildName, $hours, $minutes,$seconds, $finishline); } else { $printline = sprintf("%s: %02d:%02d:%02d running, ". "%s", $BuildName, $hours, $minutes,$seconds, $finishline); } _logevents("elapsed $BuildName\n",0); } else { @state = _get_job_state($BuildName); $printline = sprintf("%s,%d,%d,%d,%d,%d", $info[1], $TimeArray[0], $now, $difference, $paverage, $state[1]); } if ($intsethere == 1) { $isinternal = 0; } return $printline; } else { return "$BuildName on $ServerName is not currently running"; } } else { if (defined($BuildName)) { push @argarray, "-n"; push @argarray, "$BuildName"; } if (defined($rawarg)) { push @argarray, "-r"; } @return = _clientcall($ServerName, "elapsed", @argarray); return @return; } } # # Needs SQL... # sub build_status { @ARGV = @_; my $ServerName; my $title; my $bystep; my $line; my @line; my %Options; # SQL Stuff... my $sqlquery; my @sqlarray; my @sqlarray2; getopts('S:n:s', \%Options); $ServerName = $Options{S}; $title = $Options{n}; $bystep = $Options{s}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($Options{n})) { _logevents("status: $msghash{9}\n",1); return display_command_usage("status"); } if ($ServerName =~ /^$hostname/) { $sqlquery = "select state from semaphores where ". "binary server=\"$ServerName\" and binary ". "title=\"$title\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray > 0) { if ($bystep) { $sqlquery = "select step from joblog where ". "binary server=\"$ServerName\" and binary ". "title=\"$title\" order by step desc limit 1"; } else { $sqlquery = "select message from joblog where ". "binary server=\"$ServerName\" and binary ". "title=\"$title\" order by step desc limit 1"; } @sqlarray2 = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray2 > 0) { $line = $sqlarray2[0]; } } else { $line = "$title does not exist on $ServerName"; } _logevents("status $title\n",0); chomp $line; } else { @line = _clientcall($ServerName, "status", "-n", "$title"); return @line; } return $line; } sub describe_job { @ARGV = @_; my $BuildName; my $ServerName; my $Change; my $c = 0; my $Search; my $lastgood; my $rserver; my $rdepot; my $rdepotcounter; my $num; my $line; my $one; my $command; my @cmdarray; my @tmpbldarray; my @Darray; my @DepotArray; my @EmptyArray; my @rp4info; my @record; # # For SQL access... # my $sqlquery; my $returnstring1; my $returnstring2; my @sqlarray1; my @sqlarray2; my @JobArray; my @tmparray; my %Options; getopts('S:n:c:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $Change = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } $Darray[0] = "no such job $BuildName on $ServerName"; chomp $Darray[0]; if (!defined($BuildName)) { _logevents("describe: msghash{9}\n",1); return display_command_usage("describe"); } if ($ServerName =~ /^$hostname$/) { if ($BuildName =~ "all") { $Search = "[A-Z]"; } else { $Search = $BuildName; } # # Make query more readable # $sqlquery = "select title, port, client, top, type, ". "toolsdir, isimake ,keeplevel, comment, ". "sccs, browserlink from configuration ". "where binary server=\"$ServerName\" and state=\"0\""; # print "SQLQUERY = $sqlquery\n"; @sqlarray1 = $os->run_sql_query("$sqlquery", ";", 0); # print "SQLARRAY = ".@sqlarray1."\n"; foreach $returnstring1 (@sqlarray1) { @tmparray = split(/;/, $returnstring1); # # No join because we could have instances with defined # jobs and no stats, so we'll run through separate # queries... # $sqlquery = "select job from jobs where binary ". "title=\"$tmparray[0]\" and binary ". "server=\"$ServerName\" order by start desc limit 1"; @sqlarray2 = $os->run_sql_query("$sqlquery", ";", 0); foreach $returnstring2 (@sqlarray2) { $returnstring1 .= ";$returnstring2"; } push @JobArray, $returnstring1; } foreach $line (@JobArray) { my ($title,$port,$client,$top,$type,$tools,$isimake, $keep,$comment,$sccs,$cgiaccess,$lastjob) = split(/;/, $line); if ($title =~ /^$Search/i) { if (defined($lastjob)) { $lastgood = sprintf "Last good build: $webserver/$title/%s\n", $lastjob; } else { $lastgood = "Last good build: none\n"; } $Darray[$c++] = " \n"; $Darray[$c++] = "Title: $title ($type)\n"; $command = $sccs."_clientport"; if(defined($Change)) { @cmdarray = $cmbroker->$command($client, $port, $Change); } else { @cmdarray = $cmbroker->$command($client, $port); } foreach $one (@cmdarray) { $Darray[$c++] = $one; } @rp4info = ""; $Darray[$c++] = "Build root: $top\n"; $Darray[$c++] = "Save level: $keep\n"; $Darray[$c++] = "$lastgood"; $Darray[$c++] = "Comment: $comment\n"; } } if (@Darray == 0) { return "$msghash{14} $ServerName"; } _logevents("describe $ServerName $BuildName\n",0); } else { @Darray = _clientcall($ServerName, "describe", "-n", "$BuildName"); } return @Darray; } sub reject_log { @ARGV = @_; my @Contents; my @TMPArray; my $result; my $elements; my $showlast; my $ServerName; my %Options; getopts('S:l:', \%Options); $ServerName = $Options{S}; $showlast = $Options{l}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname/) { _logevents("admin rejectlog\n",0); if (-f "$dir/proc/$ServerName.errorlog") { open (LOGFILE, "<$dir/proc/$ServerName.errorlog") ||die "open: $!"; push @Contents, "\n"; push @Contents, "Reject log for $ServerName:\n\n"; while () { push @Contents, $_; } close (LOGFILE); my $elements = @Contents; if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@Contents, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @Contents; } } return @Contents; } } else { my @argarray; push @argarray, "rejectlog"; if (defined($showlast)) { push @argarray, "-l"; push @argarray, "$showlast"; } @Contents = _clientcall($ServerName, @argarray); } return @Contents; } sub connect_log { @ARGV = @_; my $ServerName; my @Contents; my @TMPArray; my $result; my $elements; my $showlast; my %Options; my @arglist; getopts('S:l:', \%Options); $ServerName = $Options{S}; $showlast = $Options{l}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($showlast)) { $showlast = 100; } _logevents("admin connectlog\n",0); if ($ServerName =~ /^$hostname$/) { if (-f "$dir/proc/$hostname.$logext") { open (LOGFILE, "<$dir/proc/$hostname.$logext") ||die "open: $!"; push @Contents, "\n"; push @Contents, "Connect log for $hostname:\n\n"; while () { push @Contents, $_; } close (LOGFILE); my $elements = @Contents; if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@Contents, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @Contents; } } return @Contents; } } else { push @arglist, "connectlog"; if ($showlast) { push @arglist, "-l"; push @arglist, "$showlast"; } @Contents = _clientcall($ServerName, @arglist); } return @Contents; } sub my_connect_log { @ARGV = @_; my @Contents; my @TMPArray; my $result; my $elements; my $ServerName; my $showlast; my %Options; my @arglist; getopts('S:l:', \%Options); $ServerName = $Options{S}; $showlast = $Options{l}; # stuff fund by strict my $x; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($showlast)) { $showlast = 100; # Pick a default value } if ($ServerName =~ /^$hostname$/) { _logevents("user connectlog\n",0); if (-f "$dir/proc/$hostname.$logext") { open (OWNLOG, "<$dir/proc/$hostname.$logext"); push @Contents, "\n"; push @Contents, "Connect log for $hostname:\n\n"; while () { $x = index($_, $peername); if ($x>0) { push @Contents, $_; } } close (OWNLOG); my $elements = @Contents; if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@Contents, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @Contents; } } return @Contents; } } else { push @arglist, "connectlog"; if ($showlast) { push @arglist, "-l"; push @arglist, "$showlast"; } @Contents = _clientcall($ServerName, @arglist); } my $numhave = @Contents; if (!$numhave) { push @Contents, "no connectlog for $peername on $ServerName"; } return @Contents } sub my_reject_log { @ARGV = @_; my @Contents; my @TMPArray; my $result; my $elements; my $ServerName; my $showlast; my %Options; # stuff found by strict my $x; getopts('S:l:', \%Options); $ServerName = $Options{S}; $showlast = $Options{l}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { _logevents("user rejectlog\n",0); if (-f "$dir/proc/$ServerName.errorlog") { open (OWNLOG, "<$dir/proc/$ServerName.errorlog"); push @Contents, "\n"; push @Contents, "Reject log for $ServerName:\n\n"; while () { $x = index($_, $peername); if ($x>0) { push @Contents, $_; } } close (OWNLOG); my $elements = @Contents; if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@Contents, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @Contents; } } return @Contents; } } else { my @arglist; push @arglist, "rejectlog"; if ($showlast) { push @arglist, "-l"; push @arglist, "$showlast"; } @Contents = _clientcall($ServerName, @arglist); } return @Contents } sub get_starts { @ARGV = @_; my @Contents; my @TMPArray; my $result; my $elements; my $ServerName; my $showlast; my @argarray; my %Options; getopts('S:l:', \%Options); my $ServerName = $Options{S}; my $showlast = $Options{l}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { _logevents("laststart\n",0); if (-f "$dir/proc/$hostname.$logext") { push @Contents, "buildserver starts:\n\n"; open (STARTLOG, "<$dir/proc/$hostname.$logext"); while () { if ($_ =~ /buildserver connectlog/) { push @Contents, $_; } } close (STARTLOG); my $elements = @Contents; if (defined($showlast)) { if ($elements > $showlast) { $result = $elements - $showlast; @TMPArray = splice(@Contents, $result, $showlast); unshift(@TMPArray, "\n"); return @TMPArray; } else { return @Contents; } } return @Contents; } } else { push @argarray, "laststart"; if ($showlast) { push @argarray, "-l"; push @argarray, "$showlast"; } @Contents = _clientcall($ServerName, @argarray); } return @Contents } sub get_changes { @ARGV = @_; my @Contents; my @TMPArray; my @JobArray; my $client; my $user = "builder"; my $port; my $result; my $elements; my $found; my $sccs; my $root; my $command; my $sccscommand; my $sccsclient; my $browser; my $ServerName; my $jobname; my $showlast; my $makeweb; my %Options; my $makeurl; # stuff found by strict my $ret; # # SQL Stuff... # my $sqlquery; my @sqlarray; my $line; getopts('S:n:l:w', \%Options); $ServerName = $Options{S}; $jobname = $Options{n}; $showlast = $Options{l}; $makeweb = $Options{w}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($jobname)) { return display_command_usage("lastchange"); } if (!_ValidJob($jobname,$ServerName,0)) { _logevents("lastchange $jobname\n",1); return "no such job $jobname on $ServerName"; } if (!defined($showlast)) { $showlast = 10; } if ($ServerName =~ /^$hostname$/) { $sqlquery = "select sccs, browserlink, top, client, port ". "from configuration where binary title=\"$jobname\" ". "and binary server=\"$ServerName\" and state=\"0\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { @JobArray = split(/;/,$line); $found = 1; } $sccs = $JobArray[0]; $browser = $JobArray[1]; $root = $JobArray[2]; $sccsclient = $JobArray[3]; $port = $JobArray[4]; $sccscommand = $sccs."_formatclientstring"; $client = $cmbroker->$sccscommand($sccsclient, $port); $found = 1; _logevents("lastchange $jobname\n",0); chomp $sccs; $command = $sccs."_lastcheckout"; if (defined($makeweb)) { $makeurl = $browser; } @Contents = $cmbroker->$command($port, $client, $root, $jobname, $showlast, $makeurl); unshift(@Contents, "\n"); } else { my @cmdargs; push @cmdargs, "lastchange"; push @cmdargs, "-n"; push @cmdargs, "$jobname"; if (defined($showlast)) { push @cmdargs, "-l"; push @cmdargs, "$showlast"; } if (defined($makeweb)) { push @cmdargs, "-w"; } @Contents = _clientcall($ServerName, @cmdargs); } return @Contents } sub get_syncs { @ARGV = @_; my $ServerName; my @Contents; my @TMPArray; my @JobArray; my $client; my $user = "builder"; my $port; my $result; my $elements; my $found; my $top; my $rserver; my $rclient; my $sccs; my @rp4array; my @rContents; my $command; my $jobname; my %Options; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; # stuff found by strict my $ret; getopts('S:n:', \%Options); $ServerName = $Options{S}; $jobname = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($jobname)) { return display_command_usage("nextjob"); } if (!_ValidJob($jobname,$ServerName,0)) { _logevents("nextjob $jobname\n",1); return "no such job $jobname"; } if ($ServerName =~ /^$hostname$/) { $sqlquery = "select port, client, top, sccs from configuration ". "where binary server=\"$ServerName\" and binary ". "title=\"$jobname\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { ($port, $client, $top, $sccs) = split(/;/, $line); $found = 1; } _logevents("nextjob $jobname\n",0); chomp $sccs; # # Use abstraction for stdoutupdate # $command = $sccs."_stdoutupdate"; @Contents = $cmbroker->$command($jobname, $port, $client, $top, $dir); unshift(@Contents, "\n"); } else { @Contents = _clientcall($ServerName, "nextjob", "-n", "$jobname"); } return @Contents } sub _getbuildroot { my $BuildRoot; my @BuildInfo; my $SearchTitle = shift; # # SQL Stuff... # my $sqlquery; my @sqlarray; $sqlquery = "select top from configuration where ". "binary server=\"$hostname\" and binary ". "title=\"$SearchTitle\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); $BuildRoot = $sqlarray[0]; return $BuildRoot } sub IsEntry { my $compname = shift; my $ret = 0; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; $sqlquery = "select machine from authtable where ". "binary server=\"$hostname\" and binary ". "machine=\"$compname\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { if ($compname =~ /^$line$/i) { $ret = 1; } } return $ret; } sub OldAddress { my $ServerName = shift; my $Job = shift; my $Addr = shift; my $ret = 0; # # SQL Stuff... # my $sqlquery; my @sqlarray; $sqlquery = "select address from subscription where ". "binary server=\"$ServerName\" and binary ". "title=\"$Job\" and address=\"$Addr\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); $ret = @sqlarray; return $ret; } sub _ValidJob { my $BuildName = shift; my $Server = shift; my $SearchType = shift; my @JobArray; my $x; my $c=0; my $sqlquery; my @sqlarray; # # Make query more readable # $sqlquery = "select title, port, client, top, type, toolsdir, ". "isimake ,keeplevel, comment, sccs, browserlink ". "from configuration where binary server=\"$Server\" ". "and binary title=\"$BuildName\" and ". "state=\"$SearchType\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $sqlquery (@sqlarray) { @JobArray = split(/;/, $sqlquery); } $c=$JobArray[7]; return $c; } sub _logevents { my $msgs = shift; my $type = shift; chomp $msgs; if (!$isinternal) { if ($type == 0) { open ( CONNECTLOG, ">>$dir/proc/$hostname.$logext"); if (defined($reqtime)) { print CONNECTLOG "$reqtime $peeraddress $msgs\n"; } else { print CONNECTLOG "$msgs\n"; } close(CONNECTLOG); } else { open ( ERRORLOG, ">>$dir/proc/$hostname.$errlogext"); if (defined($reqtime)) { print ERRORLOG "$reqtime $peeraddress $msgs\n"; } else { print ERRORLOG "$msgs\n"; } close(ERRORLOG); } } } # Function to return a joblist, there can be no duplicates... sub _getjoblist { my $ServerName = shift; my @jobName; my @Jobs; my $c = 0; # stuff found by strict my $key; # # SQL Stuff... # my @sqlarray; my $sqlquery; my $line; $sqlquery = "select title, sccs, browserlink from configuration ". "where binary server=\"$ServerName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", "0"); foreach $line (@sqlarray) { @jobName = split(/;/, $line); $jobHash{"$jobName[0]"} = "$jobName[1];$jobName[2]"; } foreach $key (keys %jobHash) { $Jobs[$c] = $key; $c++; } return @Jobs; } sub _gen_local_time_string { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($_[0]); my $returnstring = sprintf("%02d/%02d/%04d %02d:%02d:%02d", $mon+1, $mday, 1900 + $year, $hour, $min, $sec); return $returnstring; } # # Get the job state # sub _get_job_state { my $jobname = shift; my @state; my @Contents; my $entries; my @Readit; my $buildnum; my $idx; my $jobline; my $message; $jobline = build_status("-n",$jobname, "-s"); $message = build_status("-n",$jobname); $entries = @Contents; if ($jobline == 0) { @Readit = split(/ /,$message); push @state, $Readit[2]; push @state, "4"; } elsif ($jobline == 1) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "4"; } elsif (($jobline == 2 ) || ($jobline == 3) || ($jobline == 4) || ($jobline == 5)) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "5"; } elsif ($jobline == 6) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "6"; } elsif ($jobline == 7) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "0"; } return @state; } sub recover { @ARGV = @_; my $ServerName; my $BuildName; my $ret; my $line; my %Options; # # SQL Stuff... # my @sqlarray; my $sqlquery; my @sqlsubmit; my $return = "$BuildName cannot be recovered"; my @return; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("recover $BuildName: $msghash{9}\n",1); return display_command_usage("recover"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("restorejob $BuildName: $msghash{2}\n",1); return "$msghash{16}"; } if ($ServerName =~ /^$hostname$/) { $sqlquery = "select * from restore where binary ". "server=\"$hostname\" and binary title=\"$BuildName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { @sqlsubmit = split(/;/, $sqlarray[0]); if (($ret = $os->run_sql_submit("semaphores", @sqlsubmit)) == 0) { _logevents("restore: SQL failed\n",1); return "SQL failed to add record"; } $return = "recovered $BuildName semaphore information"; } _logevents("recover $BuildName\n",0); } else { @return = _clientcall($ServerName, "recover", "-n", "$BuildName"); return @return; } return $return; } sub addjob { @ARGV = @_; my $ServerName; my $BuildName; my $ret; my @iContents; my @oContents; my $a; my $line; my $return; my @return; my %Options; # # SQL Stuff... # my @sqlarray; my $sqlquery; getopts('S:n:', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("restorejob $BuildName: $msghash{9}\n",1); return display_command_usage("restorejob"); } if (_ValidJob($BuildName,$ServerName,0)) { _logevents("restorejob $BuildName: $msghash{17}\n",1); return "$msghash{17}"; } if (!_ValidJob($BuildName,$ServerName,1)) { _logevents("restorejob $BuildName: $msghash{16}\n",1); return "$msghash{16}"; } if ($ServerName =~ /^$hostname$/) { $sqlquery = "update configuration set state=\"0\" where ". "server=\"$hostname\" and title=\"$BuildName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); _logevents("restorejob $BuildName\n",0); $return = "job $BuildName restored"; } else { @return = _clientcall($ServerName, "restorejob", "-n", "$BuildName"); return @return; } return $return; } sub deljob { @ARGV = @_; my $ServerName; my $BuildName; my $Force; my $Found = 0; my $ret; my @iContents; my @oContents; my $a; my $line; my %Options; # # For SQL... # my $sqlquery; my @sqlarray; my $sqlret; my $return; my @return; my @argarray; getopts('S:n:f', \%Options); $ServerName = $Options{S}; $BuildName = $Options{n}; $Force = $Options{f}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($BuildName)) { _logevents("removejob $BuildName: $msghash{9}\n",1); return display_command_usage("removejob"); } if (!_ValidJob($BuildName,$ServerName,0)) { _logevents("removejob $BuildName: $msghash{2}\n",1); return "$msghash{2}"; } if ($ServerName =~ /^$hostname$/) { if ($Force) { $sqlquery = "delete from configuration where ". "server=\"$ServerName\" and title=\"$BuildName\""; $sqlret = $os->run_sql_remove("$sqlquery"); } else { $sqlquery = "update configuration set state=\"1\" where ". "server=\"$ServerName\" and title=\"$BuildName\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); } _logevents("removejob $ServerName $BuildName\n",0); $return = "job $BuildName removed from $ServerName"; } else { push @argarray, "removejob"; push @argarray, "-n"; push @argarray, "$BuildName"; if ($Force) { push @argarray, "-f"; } @return = _clientcall($ServerName, @argarray); return @return; } return $return; } sub show_removed { @ARGV = @_; my $ServerName; my @iContents; my @oContents; my @JobArray; my $line; my $bFound = 0; my %Options; # # SQL Stuff... # my $sqlquery; my @sqlarray; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { push @oContents, "\n"; push @oContents, "Jobs removed from buildserver control:\n\n"; $sqlquery = "select title from configuration where ". "binary server=\"$hostname\" and state=\"1\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); foreach $line (@sqlarray) { $bFound = 1; push @oContents, "\t$line\n"; } _logevents("removed\n",0); if ($bFound == 1) { return @oContents; } else { return "no removed jobs present"; } } else { @oContents = _clientcall($ServerName, "removed"); } } # # Email notification for a range of builds. # sub notify { @ARGV = @_; # # Command parameters # my $ServerName; my $job; my $start; my $end; my $msg; my %Options; my $line; my $subject; my $formatted; my @formattedinfo; my @info; my @emptyarray; my %tohash; my %mail; my $ret; my $return; my @return; my $Company = $config->COMPANY; my $ms = $config->SMTP; my $admin = $config->ADMIN; my $delim = $config->SMTPDELIM; my %to; # # SQL Stuff... # my $sqlquery; my @sqlarray; my $length; my $cgiaccess; my $sccs; getopts('S:n:f:l:c:', \%Options); $ServerName = $Options{S}; $job = $Options{n}; $start = $Options{f}; $end = $Options{l}; $msg = $Options{c}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($job)) { _logevents("notify $job: $msghash{9}\n",1); return display_command_usage("notify"); } if (!_ValidJob($job,$ServerName,0)) { _logevents("notify $job: $msghash{2}\n",1); return "$msghash{2}"; } if (!defined($start)) { _logevents("notify $job start: $msghash{9}\n",1); return display_command_usage("notify"); } if (!defined($end)) { _logevents("notify $job end: $msghash{9}\n",1); return display_command_usage("notify"); } if (!defined($msg)) { _logevents("notify $job msg: $msghash{9}\n",1); return display_command_usage("notify"); } if ($ServerName =~ /^$hostname$/) { # # Turn off logging since we'll use the 'changed' function # $isinternal = 1; @info = changed("-n", "$job", "-j", "$start", "-e", "$end"); $isinternal = 0; $sqlquery = "select address from subscription where ". "binary server=\"$ServerName\" and binary ". "title=\"$job\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); $length = @sqlarray; foreach $line (@sqlarray) { chomp $line; $mail{Bcc} = "$line$delim"; } $mail{Smtp} = $ms; $mail{From} = "Build Server <$admin>"; $mail{Subject} = "$msg"; $mail{Message} = "Changes for $job on $hostname from job $start ". "to job\n $end:\n\n"; foreach $line (sort @info) { my $command; my $emailaddress; my $formaturl; my ($who, $ver, $file, $sccs, $cgiaccess, $port) = split(/,/,$line); # # Use abstraction for stdoutupdate # $command = $sccs."_useraddress"; $emailaddress = $cmbroker->$command($who, $port); $command = $sccs."_formaturl"; $formaturl = $cmbroker->$command($file, $ver, $cgiaccess, $port); if (!defined($emailaddress)) { $emailaddress = "$who\@$Company"; } $to{"$emailaddress"} = ""; $mail{Message} .= "change: $formaturl : $who\n"; } foreach $line (keys %to) { $mail{Bcc} .= "$line$delim"; } sendmail %mail; _logevents("notify $job\n",0); $return = "$subject sent"; } else { @return = _clientcall($ServerName, "notify", "-n", "$job", "-f", "$start", "-l", "$end", "-c", "$msg"); return @return; } return $return; } # # Display files changed for a particular build # sub changed { @ARGV = @_; my $job; my $jobno; my $endjob; my $ServerName; # my $format = shift; my $ret; my %Options; getopts('S:n:j:e:', \%Options); $ServerName = $Options{S}; $job = $Options{n}; $jobno = $Options{j}; $endjob = $Options{e}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($job)) { _logevents("changed $job: $msghash{9}\n",1); return display_command_usage("changed"); } if (!_ValidJob($job,$ServerName,0)) { _logevents("changed $job $ServerName: $msghash{2}\n",1); return "$msghash{2}"; } if (!defined($jobno)) { _logevents("changed $job $jobno $endjob: $msghash{9}\n",1); return display_command_usage("changed"); } # # SQL Stuff... # my $sqlquery; my @sqlarray; my $length; my $line; my $formattedline; my $foundjob; my $foundchange; my @record; my @return; if ($ServerName =~ /^$hostname/) { # # Setup query as a range... # if (defined($endjob)) { $sqlquery = "select changes,job from changes where ". "binary server=\"$ServerName\" and binary ". "title=\"$job\" and binary job >=\"$jobno\" and ". "binary job <=\"$endjob\" order by job"; } else { $sqlquery = "select changes,job from changes where ". "binary server=\"$ServerName\" and binary ". "title=\"$job\" and job=\"$jobno\" order by job"; } @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); $length = @sqlarray; if ($length) { if (! $isinternal) { push @return, "\n"; $formattedline = sprintf "%-21s %-12s %-10s %-55s\n", "Job Number", "User", "Version", "File"; push @return, $formattedline; $formattedline = sprintf "%-21s %-12s %-10s %-55s\n", "==========", "====", "=======", "===="; push @return, $formattedline; } foreach $line (@sqlarray) { my $sccsquery; my @sccsarray; ($foundchange, $foundjob) = split(/,/,$line); @record = split(/;/, $foundchange); # # Print name, version, filename # if (!$isinternal) { chomp $record[0]; $formattedline = sprintf "%-21s %-12s %-10s %-55s\n", $foundjob, $record[3], $record[1], $record[0]; } else { $sccsquery = "select sccs, browserlink, port from jobs ". "where binary server=\"$ServerName\" and ". "binary title=\"$job\" and job=\"$foundjob\""; @sccsarray = $os->run_sql_query($sccsquery, ";"); my ($sccs, $link, $port) = split(/;/, $sccsarray[0]); $formattedline = sprintf "%s,%s,%s,%s,%s,%s", $record[3], $record[1], $record[0], $sccs, $link, $port; } push @return, "$formattedline"; } if (!$isinternal) { push @return, "\n"; } } else { push @return, "no records found!"; } _logevents("changed $ServerName $job $jobno $endjob\n",0); } else { my @argarray; push @argarray, "changed"; push @argarray, "-n"; push @argarray, "$job"; if (defined($jobno)) { push @argarray, "-j"; push @argarray, "$jobno"; } if (defined($endjob)) { push @argarray, "-e"; push @argarray, "$endjob"; } @return = _clientcall($ServerName, @argarray); } return @return; } # # Build Server HW/SW combination # sub sysinfo { @ARGV = @_; my $ServerName; my %Options; my @retarray; getopts('S:', \%Options); $ServerName = $Options{S}; if (!defined($ServerName)) { $ServerName = $hostname; } _logevents("sysinfo\n",0); if ($ServerName =~ /^$hostname$/) { return $os->sysinfo(); } else { @retarray = _clientcall($ServerName, "sysinfo"); } return @retarray; } # # FIXFIX - need to abstract some of these calls to support CVS # sub createjob { @ARGV = @_; my %opts; my $validopt; my $bMissing = 0; my $bGood = 0; my $sGood = 0; my $ret; my $ServerName; my $dump = 0; my $buildname; my $port; my $client; my $top; my $type; my $tools; my $isimake = "no"; my $keep; my $comment; my $sccs; my $browser; my $state = 0; my $spam; my $size = 1; # # SQL Stuff... # my @SQLArray; my $sqlquery; my @sqlarray; my @errormsg; my @supported = qw ( perforce cvs ); my @options = qw (n p c r t d k C s b m); my @types = qw (retail debug both); my $invalidchars = "#\\s\\t;:\\<\\>,\\.\\?\\/\\'\\\"\\[\\]\\{\\}\\\\\\|!-()"; my $dinvalidchars = "#\\s\\t;\\<\\>,\\?\\/\\'\\\"\\[\\]\\{\\}\\|!()"; # OS SPECIFIC my @initfiles = qw (prebuild.sh postbuild.sh onfail.sh); getopts("S:n:p:c:r:t:d:k:C:s:b:m:D", \%opts); $ServerName = $opts{S}; $buildname = $opts{n}; $port = $opts{p}; $client = $opts{c}; $top = $opts{r}; $type = $opts{t}; $tools = $opts{d}; $keep = $opts{k}; $comment = $opts{C}; $sccs = $opts{s}; $browser = $opts{b}; $spam = $opts{m}; $dump = $opts{D}; if (!defined($ServerName)) { $ServerName = $hostname; } if (!defined($buildname)) { return "missing job name"; } if ($dump) { if (!_ValidJob($buildname,$ServerName,0)) { _logevents("createjob dumper nonexistant job $buildname\n",1); return "job $buildname on $ServerName undefined"; } $sqlquery = "select * from configuration where binary ". "server=\"$ServerName\" and binary title". "=\"$buildname\" limit 1"; @sqlarray = $os->run_sql_query($sqlquery, ","); ($ServerName,$buildname,$port,$client,$top,$type,$tools, $isimake,$keep,$comment,$sccs,$browser,$state,$spam, $size) = split(/,/, $sqlarray[0]); return "createjob -n $buildname -p $port -c $client -r $top ". "-t $type -d $tools -k $keep -s $sccs -b $browser ". "-m $spam -C\"$comment\""; } push @errormsg, "\n"; foreach $validopt (@options) { if (!defined($opts{$validopt})) { if ($bMissing == 0) { print "Incomplete or missing argument: "; $bMissing = 1; } push @errormsg, "missing arg -$validopt\n"; } } if ($bMissing == 1) { _logevents("createjob missing option\n",1); # return display_command_usage("createjob"); return @errormsg; } if ($buildname =~ /[$invalidchars]/) { _logevents("createjob invaild jobname\n",1); return "invalid characters in job name\n"; } # # TODO # # Need to abstract a port vrification routine # if ($port !~ /^[A-Za-z0-9.]+:[0-9]+/ && $sccs !~ /cvs/i) { _logevents("createjob invaild portname\n",1); return "invalid port specification\n"; } else { if ($sccs =~ /perforce/i) { open (CP, "p4 -u $p4user -p $port users 2>&1|"); while () { if ($_ =~ /Connect to server failed/) { _logevents("createjob invaild port\n",1); return "invalid port!\n"; } } close (CP); } } if ($client =~ /[$invalidchars]/ && $sccs !~ /cvs/i ) { _logevents("createjob invaild client name\n",1); return "invalid characters in client name\n"; } if (!$POSIX) { $top =~ s/\//\\/g; } if (!$POSIX) { if (($top !~ /^[A-Za-z]:\\[A-Za-z0-9]+/) || ($top =~ /[$dinvalidchars]/)) { _logevents("createjob invaild root spec\n",1); return "invalid characters in root specification\n"; } } else { if ($top !~ /^\//) { _logevents("createjob invaild root spec\n",1); return "invalid characters in root specification\n"; } } # # Look for supported SCCS system... # foreach my $tmplook (@supported) { if ($opts{s} =~ /^$tmplook$/i) { $sGood = 1; } } if ($sGood == 0) { _logevents("createjob invaild sccs\n",1); return "invalid sccs specified\n"; } foreach $validopt (@types) { if ($type =~ /^$validopt$/i) { $bGood = 1; } } if ($bGood == 0) { _logevents("createjob invaild type\n",1); return "invalid type specified\n"; } if (!$POSIX) { $tools =~ s/\//\\/g; if (($tools !~ /^[A-Za-z]:\\[A-Za-z0-9]+/) || ($tools =~ /[$dinvalidchars]/)) { _logevents("createjob invaild tool spec\n",1); return "invalid characters in tools specification\n"; } } else { if ($tools !~ /^\//) { _logevents("createjob invaild tools spec\n",1); return "invalid characters in tools specification\n"; } } if ($keep !~ /^[0-9]+$/) { _logevents("createjob invaild keep type\n",1); return "non-numeric keep level specified\n"; } if (_ValidJob($buildname,$ServerName,0)) { _logevents("createjob job exists\n",1); return "job already defined and under build control"; } if (_ValidJob($buildname,$ServerName,1)) { _logevents("createjob job exists\n",1); return "job defined but not under build control"; } push @SQLArray, "$ServerName"; push @SQLArray, "$buildname"; push @SQLArray, "$port"; push @SQLArray, "$client"; push @SQLArray, "$top"; push @SQLArray, "$type"; push @SQLArray, "$tools"; push @SQLArray, "$isimake"; push @SQLArray, "$keep"; push @SQLArray, "$comment"; push @SQLArray, "$sccs"; push @SQLArray, "$browser"; push @SQLArray, "0"; push @SQLArray, "$spam"; push @SQLArray, "$size"; if (($ret = $os->run_sql_submit("configuration", @SQLArray)) == 0) { _logevents("createjob: SQL failed \n",1); return "SQL failed to add record"; } if (defined($opts{f})) { if (! -d $top) { open (CMD, "mkdir $top|") || die "$!: mkdir $opts{r}"; close (CMD); } for my $file (@initfiles) { open (IN, "<$dir/skeleton/$file") || die "$!: open in"; my @contents = ; close (IN); open (OUT, ">$top/$file") || die "$!: open out"; print OUT @contents; close(OUT); } } _logevents("createjob $opts{n}\n",0); return "job $buildname created on $ServerName"; } sub genweb { @ARGV = @_; # # Setup some global variables # my $one; my $c; my @temparray; my @tmparray; my @jobs; my $templine; my @TmpJob; my $jj; my $ServerName; my $JobName; my %Options; $viewitems = 0; getopts('S:n:l:', \%Options); $ServerName = $Options{S}; $JobName = $Options{n}; $viewitems = $Options{l}; # # Initialize global variables # %mainhash = %emptyhash; %jobhash = %emptyhash; @jobarray = @emptyarray; @stats = @emptyarray; %idlehash = %emptyhash; %statehash = %emptyhash; @reversearray = @emptyarray; @timearray = @emptyarray; %workhash = %emptyhash; @webarray = @emptyarray; # stuff found by strict my $entry; my $pass; my $showit; my $key; my $doskip; my $futurestate; my $printstring; my $xxx; my $zzz; my $xzxz; my $job; my $line; my @TheseJobs; my $g_all = 0; # # Get the number of jobs to display # if (!defined($JobName) || !($viewitems)) { $isinternal = 0; _logevents("genweb $JobName $viewitems: $msghash{7}\n",1); return display_command_usage("genweb"); } if (!defined($ServerName)) { $ServerName = $hostname; } if ($ServerName =~ /^$hostname$/) { $isinternal = 1; _getjoblist($ServerName); $itsnow = $os->_get_hosttime(); # $itsnow = time(); my @SELPLATFORM; my @JOBS; $HASARGS = 0; # # Did we get an arg from the command line? # if ($JobName =~ /^all$/) { @temparray = describe_job('-n', 'all'); foreach $templine (@temparray) { if ($templine =~ /Title\:/) { push @TheseJobs, $templine; } } unshift(@TheseJobs, "all"); foreach $job (@TheseJobs) { if ($job ne "all") { push @jobs, $job; } } $HASARGS = 1; } else { my @TJobs = split(/ /, $JobName); foreach my $_job (@TJobs) { @temparray = describe_job('-n', "$_job"); foreach $templine (@temparray) { if ($templine =~ /Title\:/) { push @TmpJob, $templine; } } foreach $entry (@TmpJob) { push @jobs, $entry; } } $HASARGS = 1; } # # Get jobs into a hash table # %jobhash = _getjobnames(@jobs); %idlehash = %jobhash; %statehash = %jobhash; %workhash; # Initialize Job description arrays... foreach $one (keys %jobhash) { @$one = describe_job('-n', "$one"); } # # Read through the hash table... # foreach $key (sort keys %jobhash) { my $mainaverage; push @jobarray, $key; # # Get stats for each job... # @stats = runstats("-n", $key,"-l" ,$viewitems, "-r"); $mainaverage = $os->_get_average($ServerName, $key); _get_running_jobs($key); # # Read stats into the hash, this will take care of jobs fired off # at exactly the same time. # foreach $line (@stats) { # # Remove newline # chomp $line; if ($line ne " ") { # # Generate an array from each line. # @tmparray = split (/,/, $line); # # Ignore bogus entries... # if ($tmparray[1] ne "" ) { # # Get rid of space in job number... # $tmparray[0] =~ s/ //g; # # Add entry to hash table... # %{ $mainhash{$tmparray[1]}{$key} } = ( jobno => $tmparray[0], length => $tmparray[3], finish => $tmparray[2], avg => $mainaverage, status => $tmparray[5], lastcg => $tmparray[6], ); if (defined($tmparray[2])) { foreach $jj (keys %jobhash) { %{ $mainhash{$tmparray[2]}{$jj} } = ( status => 99, ); } if (defined ($mainhash{$tmparray[2]}{$key}{status})) { delete($mainhash{$tmparray[2]}{$key}{status}); } %{ $mainhash{$tmparray[2]}{$key} } = ( $tmparray[1], ); } foreach $jj (keys %jobhash) { if (!defined ($mainhash{$tmparray[1]}{$jj}{jobno})) { %{ $mainhash{$tmparray[1]}{$jj} } = ( status => 99, ); } } } } } } _genheader(); foreach $job (keys %jobhash) { $statehash{$job} = 0; } foreach $key (sort keys %mainhash) { push @timearray, $key; } $pass = 1; # # Print entries from sorted hash table (sorted by start) # foreach $key (sort keys %mainhash) { # # Increment counters for all jobs, set statehash # foreach $job (keys %jobhash) { $jobhash{$job}++; $idlehash{$job}++; } # # Print start time (main entry point into hash) # push @reversearray, "\n"; # # Since there's another has here, read through it... # $a = 1; foreach $entry (reverse sort keys %{ $mainhash{$key} }) { # # This should print out jobname... # $zzz = 0; foreach $xzxz (keys %{ $mainhash{$key}{$entry}}) { $zzz++; } if (defined($mainhash{$key}{$entry}{finish})) { $idlehash{$entry} = 1; $statehash{$entry} = 1; $xxx = $mainhash{$key}{$entry}{finish}; %{ $mainhash{$xxx}{$entry}} = ( $key, ); } # # Here's where the nasty stuff starts # foreach $one (keys %{ $mainhash{$key}{$entry} } ) { # # We found the start of the build, time to print # skipline info # if (!defined($mainhash{$key}{$entry}{status})) { $printstring = _gendisplaystring(@$entry,$one); # # Push this onto the array # push @reversearray, "$printstring\n"; # # Reset build states (we become idle) # $idlehash{$entry} = -1; $statehash{$entry} = 0; } if (defined($mainhash{$key}{$entry}{$one})) { # # If this isn't a 'filler' (status = 99) # if ($mainhash{$key}{$entry}{$one} != 99) { $doskip = 1; } elsif ($statehash{$entry} == 0) { # # Use entries from the array to look at the # next entry to see if this job fires off. # $futurestate = _inthefuture($pass, $entry); # # The next time entry has a start for this job, # print skipline info for the accumulated idle # entries # if ($futurestate == 1) { $idlehash{$entry}++; push @reversearray, "". " \n"; } else { ; } } } else { # # This is the end of the build, set the # skipcounter to 0 # $jobhash{$entry} = 0; $jobhash{$entry} = 0; } } # # Here we reset the skipline counter to 0 # if ($doskip == 1) { # # Print skipline, reset counter to 0... # $jobhash{$entry} = 0; $doskip = 0; } $a++; } $showit = _gen_time_string($key,0); push @reversearray, "$showit\n"; push @reversearray, "\n"; $pass++; } foreach $entry (reverse @reversearray) { push @webarray, $entry; } push @webarray, ""; push @webarray, ""; $isinternal = 0; _logevents("genweb @_\n",0); } else { @webarray = _clientcall($ServerName, "genweb", "-n", "$JobName", "-l", "$viewitems"); } return @webarray; } # # Function to read jobs into a hash table # sub _getjobnames { my $entry; my @details; my %return; my $c; foreach $entry (@_) { @details = split(/ /, $entry); # # We're going to use this as the skipline counter... # $return{$details[1]} = 0; } return %return; } sub _genheader { my $numjobs = @jobarray; my @statusfile; my $line; my $printline; my $disabled; my $IDLEMSG = "Job Idle"; # Stuff found by strict my $entry; my $hereandnow; my $mm; my $jc = 0; my $disicon = $config->DISICON; my $logoicon = $config->LOGOICON; my $webroot = $config->WEBROOT; my $infoicon = $webroot."/icons/info2.gif"; my ($desc, $port, $stat);; my $sqlquery; my @sqlarray; my $product = "Continuous Automated Build and Integration Environment"; push @webarray, < $product
LOGO

$product

Mouse over any icon for additional information



Key :

$IDLEMSG" Syncing" Building" Overdue" Generating Email Build Untested Build Passed Test Build Failed Failed Test

Job # or F - Download Files/View Logs Job # or L - View 'building' Logs U - View Job Update NA - Not Available
Jobnames are linked to build instructions

EOF # # If there were no args just supply the date/time # if ($HASARGS == 0) { $hereandnow = _gen_time_string($itsnow,0); push @webarray, <
Time
$hereandnow
EOF } if ($HASARGS) { $sqlquery = "select description, port, status from buildservers ". "where binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ":"); ($desc, $port, $stat) = split(/:/, $sqlarray[0]); my $alttext = "$desc\nStatus: running on port $port"; my $srvpopup = _do_popup($alttext, "Server Info"); @statusfile = jobstate(); push @webarray, "$hostname". "". "\n". "\n"; } push @webarray, < EOF foreach $entry (sort keys %jobhash) { $disabled = 0; foreach $line (@statusfile) { if ($line =~ /\[$entry build job disabled/) { $disabled = 1; $printline = $line; chomp $printline; } } # # If the build is now disabled # if (!$disabled) { push @webarray, "". "$entry\n"; } else { push @webarray, "". "$entry\n"; } } push @webarray, < EOF } sub _inthefuture { my $recno = shift; my $name = shift; if (!defined($timearray[$recno])) { return 1; } if (defined($mainhash{$timearray[$recno]}{$name}{finish})) { return 1; } return 0; } sub _get_running_jobs { my $jobname = $_[0]; my $jobno; my $start; my $now; my $elapsed; my $average; my $state; my $cmdrtn = elapsed("-n", "$jobname" ,"-r"); chomp $cmdrtn; ($jobno,$start,$now,$elapsed,$average,$state) = split(/,/,$cmdrtn); if (defined($state)) { $now = $itsnow; $elapsed = $now - $start; push @stats, " $jobno,$start,$now,$elapsed,$average,$state"; } } sub _getlastnum { my $x; my $buildnum; $buildnum = $_[0]; $x = rindex($buildnum, "\."); return substr($buildnum,$x+1); } sub _returnsccs { my @Ref = split(/ /, $_[0]); my @return = split(/;/, $jobHash{$_[0]}); return $return[0]; } sub _returncgi { my @Ref = split(/ /, $_[0]); my @return = split(/;/, $jobHash{$_[0]}); return $return[1]; } sub _returnjobname { my @Ref = split(/ /, $_[0]); return $Ref[1]; } sub _returnjobcomment { my @Ref = split(/: /, $_[0]); return $Ref[1]; } sub _returndepots { my $n = @_; my $c; my @Ref; my @MultiRef; # 8 Is the standard configuration for a single depot... if ($n == 8) { my @Ref = split(/: /,$_[2]); return $Ref[1]; push @MultiRef, $Ref[1]; } else { for ($c = $n-6; $c > 1; $c--) { @Ref = split(/: /,$_[$c]); push @MultiRef, $Ref[1]; } } return @MultiRef; } sub getjoblist { my $one = 1; my $entry; my @ReturnJobArray; foreach $entry (@JobList) { chomp($entry); if ($entry =~ /^ Title:/) { my ($msg, $title) = split(/:/,$entry); push @ReturnJobArray, "$one : $title"; $one++; } } return @ReturnJobArray; } # # A big mess here... # sub _gendisplaystring { my @JobInfo = @_; my $cc = @JobInfo; my $nums = @JobInfo; my $entry = $JobInfo[$nums-1]; my $JobName = _returnjobname($JobInfo[1]); my $Comment = _returnjobcomment($JobInfo[$nums-2]); my $sccs = _returnsccs($JobName); my $cgiaccess = _returncgi($JobName); my $depot = $JobInfo[2]; my @CnArray; my $START = $entry; my $FINISH = $mainhash{$entry}{$JobName}{finish}; my $CN = $mainhash{$entry}{$JobName}{jobno}; my $STATUS = $mainhash{$entry}{$JobName}{status}; my $LASTCG = $mainhash{$entry}{$JobName}{lastcg}; my @CvsLast; my @PrimaryPort = split(':',$depot); my $startstring = _gen_time_string($START,0); my $finishstring = _gen_time_string($FINISH,0); my $elapsed = _format_elapsed_time($FINISH - $START); my @p4db; # Stuff found by using strict my $trunstring; my $ttotalstring; my $tfinishstring; my $CNSHORT; my $tlogstring; my $c; my $d; my $byhowlong; my @running; my $identity; my $sccscommand; my $refline; my $formattedcgi; my @promotearray; my $promotestring; # # Javascript strings # my $popupstring; my $commentpop; my $infostring; my $popstring; my $sccspop; my $savedcn; my $bImrunning = 0; # # SQL Stuff... # my $sqlquery; my @sqlarray; my @queryarray; my $sqlline; my $promoline; my $promopop; my $finishimage = "$runicon"; chomp $elapsed; # # Grab the right sccs icon from buildconf # my $sccssystem = uc("$sccs"); my $sccsicon = $config->{$sccssystem}; if (($STATUS == 0) || ($STATUS == 1) || ($STATUS == 2) || ($STATUS == 3)) { # # Setup total and elapsed strings # $ttotalstring = "Total: $elapsed"; $tfinishstring = "Finish: $finishstring"; # # Need to make this generic, but for now this will work... # if (-d "$Moutdir/$JobName/$CN") { my @fullcn = split(/\./, $CN); my $numcn = @fullcn; $tlogstring = "". "$fullcn[$numcn-1]\n"; } else { $tlogstring = "NA\n"; } # # Initialize to nothing # $trunstring = ""; if ($STATUS == 1) { $finishimage = "$yellowicon"; } elsif ($STATUS == 2 ) { $finishimage = "$redicon"; } else { $finishimage = "$greenicon"; } } else { # # Make sure these are blank # $tlogstring = ""; $trunstring = ""; # # Since there's no status we need to see what's up with the job # @running = build_status("-n", $JobName); $trunstring = "\nProgress: "."$running[0]"; $bImrunning = 1; chomp $trunstring; if ($STATUS == 5) { if ($running[0] =~ /building retail/ ) { $tlogstring = "L\n"; } elsif ($running[0] =~ /building debug/ ) { $tlogstring = "L\n" } } $tfinishstring = "Elapsed: $elapsed\n"; my $remain = $mainhash{$entry}{$JobName}{avg} - ($FINISH - $START); if ($remain < 0) { $byhowlong = _format_elapsed_time(($FINISH - $START) - $mainhash{$entry}{$JobName}{avg}); $mainhash{$entry}{$JobName}{status} = 7; $ttotalstring = "Overdue: $byhowlong"; } else { my $remainder = _format_elapsed_time($remain); $ttotalstring = "TIME LEFT: $remainder"; } } chomp $ttotalstring; my $cnstring; chomp $cnstring; @p4db = split(/ /,$PrimaryPort[0]); # # Create a call to CM broker # chomp $sccs; chomp $depot; $sccscommand = $sccs."_identity"; # # Call the broker # $formattedcgi = $cmbroker->$sccscommand($CN, $depot, $cgiaccess); $refline = $formattedcgi; $sqlquery = "select at, bywhom, comment from promotion ". "where binary server=\"$hostname\" and binary ". "title=\"$JobName\" and job=\"$CN\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { foreach $sqlline (@sqlarray) { @queryarray = split(/;/, $sqlline); } $promoline = "Promoted at : $queryarray[0]\n". "Promoted by : $queryarray[1]\n". "Comment : $queryarray[2]"; $promopop = _do_popup($promoline, "Promotion Info"); $promotestring = " ". ""; } else { $promotestring = ""; } # # If this job has completed building # if (($STATUS == 0) || ($STATUS == 1) || ($STATUS == 2) ||($STATUS == 3)) { $sqlquery = "select comment from comments ". "where binary server=\"$hostname\" and binary ". "title=\"$JobName\" and job=\"$CN\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { $commentpop = _do_popup2("$sqlarray[0]", "Build Comment"); $popupstring = _do_popupstring("$cgibin/gencomment", $hostname, $JobName, $CN); $infostring = "". ""; } else { $commentpop = _do_popup2("Click to enter comments\nfor this build.", "Enter Comment"); $popupstring = _do_popupstring("$cgibin/gencomment", $hostname, $JobName, $CN); $infostring = "". ""; } } my $altline = "Jobname : $JobName\n". "Build Server : $hostname\n". "Comment : $Comment". "Job Identifier : $CN\n". "Start : $startstring". "$tfinishstring". "$ttotalstring". "$trunstring"; $popstring = _do_popup($altline, "Job Info"); $savedcn = $cmbroker->$sccscommand($CN,$depot); $sccspop = _do_popup("$savedcn", "CM Info"); my @zstring; if ($bImrunning == 1) { @zstring = split(/TIME LEFT: /, $ttotalstring); } elsif ($bImrunning == 2) { @zstring = split(/Overdue: /, $ttotalstring); } else { $refline = "U "; } return $tlogstring. $refline. "
". "". "". "". $infostring. " ". "". "". $promotestring. "
".$zstring[1]. "\n"; } sub _gen_time_string { my $arg = $_[1]; my $returnstring; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($_[0]); 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); } return $returnstring; } sub _format_elapsed_time { my $difference = shift; my $seconds = $difference % 60; my $difference = ($difference - $seconds) / 60; my $minutes = $difference % 60; my $difference = ($difference - $minutes) / 60; my $hours = $difference % 24; my $difference = ($difference - $hours) / 24; my $days = $difference % 7; my $weeks = ($difference - $days) / 7; my $returnstring = sprintf("%02d:%02d:%02d", $hours, $minutes,$seconds); return $returnstring; } sub _catfile { my $filename = shift; my @contents; if (-f "$filename") { open (LF, "<$filename") || die "open: $?"; @contents = ; close (LF); } else { push @contents, "$filename not found"; } return @contents; } sub _catch_sig { print "args: @_"; my $signame = shift; my $delim = $config->SMTPDELIM; # # Mail configuration # my $ms = $config->SMTP; my $admin = $config->ADMIN; my $alternate = $config->ALTERNATE; my %mail; my $sigtime = sprintf "%s", scalar localtime; $mail{Smtp} = $ms; $mail{From} = "Build Server <$admin>"; $mail{To} = "$admin$delim$alternate"; $mail{Subject} = "*Urgent - buildserver $hostname unexpected signal ". "caught !*"; $mail{Message} = "buildserver $hostname process signaled at $sigtime:\n". "\nCaught SIG$signame\n"; sendmail %mail; } # # Function for determining whether or not there's enough space for a build # sub _freespace { my $jobname = shift; my $free; my $volume; my @usage; my $delim = $config->SMTPDELIM; my $sqlquery; _debuglogger("in _freespace checking for $jobname"); # # Look for a usage file # if (-f "$dir/proc/$jobname.usage") { _debuglogger("found proc/$jobname.usage"); open (USAGE, "<$dir/proc/$jobname.usage") || die "open: $!"; @usage = ; close(USAGE); _debuglogger("usage: $usage[0]"); } else { $sqlquery = "select buildsize from configuration where binary ". "title=\"$jobname\" and binary server=\"$hostname\""; _debuglogger("need to check with sql $sqlquery"); @usage = $os->run_sql_query($sqlquery, ";"); if (!defined($usage[0])) { _debuglogger("no useage defined"); return 0; } _debuglogger("usage: $usage[0]"); } # # Unix returns blocks (block size depends on the FS) # Win32 returns bytes. Usage is calculated automatically # with each completed job. # $free = $os->diskspace(); $volume = $os->volume; _debuglogger("freespace: $free"); _debuglogger("volume: $volume"); if ($usage[0] > $free) { _debuglogger("out of build space"); # # Mail configuration # my $ms = $config->SMTP; my $admin = $config->ADMIN; my $alternate = $config->ALTERNATE; my $iscontact = $config->ISADDR; my %mail; my $sigtime = sprintf "%s", scalar localtime; $mail{Smtp} = $ms; $mail{From} = "Build Server <$admin>"; $mail{To} = "$admin$delim". "$iscontact"; $mail{Subject} = "*Urgent - buildserver out of space !*"; $mail{Message} = "buildserver $hostname is out of free space:\n". "$volume: $free bytes of unused space\n"; sendmail %mail; return 1; } else { _debuglogger("we still have build space"); return 0; } } # # Register server in SQL # sub _registerserver { my $sqlquery; my @sqlarray; my @sqlsubmit; my $myret = 0; my $ret; $sqlquery = "select server from buildservers where ". "binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray == 0) { my $info = $os->sysinfo(); push @sqlsubmit, "$hostname"; push @sqlsubmit, "$info"; push @sqlsubmit, "$Opts{s}"; push @sqlsubmit, "1"; push @sqlsubmit, $config->GLOBMAIL; if (($ret = $os->run_sql_submit("buildservers", @sqlsubmit)) == 0) { $myret = 1; } } $sqlquery = "update buildservers set status=\"1\",". "port=\"$Opts{s}\" where binary server=\"$hostname\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); return $myret; } # # TODO - should use as change permissions for any SCCS # sub changecvsmodule { my $project = shift; my $module = shift; my $user = shift; my $projectfile = "cvsprojects"; my @project; my $line; my $key; my @return; my $bFound = 0; if (!defined($project)) { _logevents("cvsperms $project $module $user\n",1); return display_command_usage("cvsmodule"); } open (PROJECTS, "$CVSROOT/$projectfile") || die "opening cvsprojects"; @project = ; close(PROJECTS); sort @project; if ($project =~ /^list$/) { push @return, "\n"; my $formatted = sprintf("%-25s %-15s %-25s\n", "Project", "Module", "Userlist"); push @return, $formatted; my $formatted = sprintf("%-25s %-15s %-25s\n", "=======", "======", "========"); push @return, $formatted; foreach $line (@project) { chomp $line; if ($line =~ /^[\w]/) { my ($p, $l, $m, $t, $w, $r) = split(/:/, $line); if (defined($module)) { if ($line =~ /^$module/) { $formatted = sprintf("%-25s %-15s %-25s\n", $p, $m, $w); push @return, "$formatted"; } } else { $formatted = sprintf("%-25s %-15s %-25s\n", $p, $m, $w); push @return, "$formatted"; } } } } else { if (!defined($module) || !defined($user)) { _logevents("cvsperms $project $module $user\n",1); return display_command_usage("cvsmodule"); } open (PROJECT, ">$CVSROOT/cvsprojects.new"); foreach $line (@project) { chomp $line; if ($line =~ /^[\w]/) { my ($p, $l, $m, $t, $w, $r) = split(/:/, $line); if ($module =~ /^$m$/ && $project =~ /^$p$/) { print PROJECT "$p:$l:$m:$t:$user:$r\n"; $bFound = 1; } else { print PROJECT "$line\n"; } } else { print PROJECT "$line\n"; } } close(PROJECT); if ($bFound) { system("mv $CVSROOT/cvsprojects.new $CVSROOT/$projectfile"); chdir "$CVSROOT" || die "chdir: $?"; system("cvs ci -m \"$project $module $user\" $projectfile"); chdir $dir || die "chdir: $?"; push @return, "cvs module $module updated\n"; } else { push @return, "nothing to update\n"; } } # Display a message to the console... _logevents("cvsperms $project $module $user\n",0); return @return; } # # Separate thread use for polling jobs # sub pendingjobs { # # SQL variables # my $sqlquery; my $lsqlquery; my @sqlarray; my @lsqlarray; my @pollarray; # # Job variables # my @properties; my $line; my $lline; my $bCheck = 1; my $title; my $port; my $client; my $top; my $sccs; my $elapsed; my @elapsed; my $command; my $sport = $os->sport; my $pollfile = $config->POLLFILE; my $bsr = $config->BSR; my $jobs; my @updates; my $update; my $numupdates; # # Sleep interval between checking jobs # my $sleepinterval = 120; my $c; open (PTHREADLOG, ">$dir/proc/pendmon.log"); PTHREADLOG->autoflush(1); _pthreadlogger("starting pending thread - monitor port: $mport"); while (1) { @sqlarray = ""; if (! -f "$bsr/$pollfile") { _pthreadlogger("no pollfile"); $sqlquery = "select * from configuration where binary server=". "\"$hostname\" and state=\"0\""; @sqlarray = $os->run_sql_query($sqlquery, ";"); } else { _pthreadlogger("opening pollfile $pollfile"); open(PPOLLFILE, "<$bsr/$pollfile") || print STDERR "error opening pollfile: $?"; while() { chomp; if ($_ !~ /^[#\n\t\r\ ]/ && $_ !~ /^$/) { _pthreadlogger("entry from $pollfile = $_"); $sqlquery = "select * from configuration where binary ". "server=\"$hostname\" and binary ". "title=\"$_\" and state=\"0\""; @pollarray = $os->run_sql_query($sqlquery, ";"); $sqlarray[$c++] = $pollarray[0]; } } close(PPOLLFILE); _pthreadlogger("closed pollfile $pollfile"); } foreach $line (@sqlarray) { $bCheck = 1; @properties = split(/;/, $line); $title = $properties[1]; $port = $properties[2]; $client = $properties[3]; $top = $properties[4]; $sccs = $properties[10]; if ($title !~ /^$/ && $bCheck) { _pthreadlogger("build $title disabled or running"); $command = $sccs."_stdoutupdate"; @updates = $cmbroker->$command($title, $port, $client, $top, $dir); $numupdates = @updates; if ($numupdates) { $command = $sccs."_format_pending"; my @formatted = $cmbroker->$command(@updates); _pushpending($title, @formatted); } else { # # Make sure any records that exist are purged # my $sqlquery = "delete from pending where binary ". "server=\"$hostname\" and binary ". "title=\"$title\""; $os->run_sql_remove($sqlquery); } } } _pthreadlogger("sleeping for $sleepinterval seconds"); sleep($sleepinterval); } close(PTHREADLOG); } # # Separate thread use for polling jobs # sub polljobs { # # SQL variables # my $sqlquery; my $lsqlquery; my @sqlarray; my @lsqlarray; my @pollarray; # # Job variables # my @properties; my $line; my $lline; my $bCheck = 1; my $title; my $port; my $client; my $top; my $sccs; my $elapsed; my @elapsed; my $command; my $sport = $os->sport; my $pollfile = $config->POLLFILE; my $bsr = $config->BSR; my $jobs; my @updates; my $update; my $numupdates; # # Sleep interval between checking jobs # my $sleepinterval = 120; my $c; open (THREADLOG, ">$dir/proc/mon.log"); THREADLOG->autoflush(1); _threadlogger("starting polling thread - monitor port: $sport"); while (1) { # # Create a list of locked jobs # $lsqlquery = "select c.title from configuration as c, semaphores ". "as s where binary c.server=\"$hostname\" and binary ". "c.title=s.title and binary c.server=s.server and ". "s.state > 0"; @lsqlarray = $os->run_sql_query($lsqlquery, ","); $c = 0; @sqlarray = ""; if (! -f "$bsr/$pollfile") { _threadlogger("no pollfile"); $sqlquery = "select * from configuration where binary server=". "\"$hostname\" and state=\"0\""; @sqlarray = $os->run_sql_query($sqlquery, ";"); } else { _threadlogger("opening pollfile $pollfile"); open(POLLFILE, "<$bsr/$pollfile") || print STDERR "error opening pollfile: $?"; while() { chomp; if ($_ !~ /^[#\n\t\r\ ]/ && $_ !~ /^$/) { _threadlogger("entry from $pollfile = $_"); $sqlquery = "select * from configuration where binary ". "server=\"$hostname\" and binary ". "title=\"$_\" and state=\"0\""; @pollarray = $os->run_sql_query($sqlquery, ";"); $sqlarray[$c++] = $pollarray[0]; } } close(POLLFILE); _threadlogger("closed pollfile $pollfile"); } foreach $line (@sqlarray) { $bCheck = 1; @properties = split(/;/, $line); $title = $properties[1]; $port = $properties[2]; $client = $properties[3]; $top = $properties[4]; $sccs = $properties[10]; foreach $lline (@lsqlarray) { if ($title =~ /^$lline$/) { $bCheck = 0; } } if (!$bCheck) { _threadlogger("build $title disabled or running"); $command = $sccs."_stdoutupdate"; @updates = $cmbroker->$command($title, $port, $client, $top, $dir); $numupdates = @updates; if ($numupdates) { $command = $sccs."_format_pending"; my @formatted = $cmbroker->$command(@updates); _pushpending($title, @formatted); } } if ($title !~ /^$/ && $bCheck) { _threadlogger("checking for updates in \"$title\""); # # Use abstraction for stdoutupdate # $command = $sccs."_stdoutupdate"; @updates = $cmbroker->$command($title, $port, $client, $top, $dir); $numupdates = @updates; if ($numupdates) { _pushpending($title, @updates); _requestbuild($title); _spintilldry($title); } } else { _threadlogger("undefined value found for title, ignoring"); } } _threadlogger("sleeping for $sleepinterval seconds"); sleep($sleepinterval); } close(THREADLOG); } # # Push pending changes into db # sub _pushpending { my $title = shift; my @changes = @_; my @submit; my $list; my $string; my $sqlquery = "delete from pending where binary server=\"$hostname\" ". "and binary title=\"$title\""; $os->run_sql_remove($sqlquery); _pthreadlogger("$sqlquery"); foreach $list (@changes) { $string .= "$list"; } push @submit, $hostname; push @submit, $title; push @submit, $string; $os->run_sql_submit("pending", @submit); _pthreadlogger("submitted pending files for $title"); } # # On polling thread, wait for build to complete # sub _spintilldry { my $title = shift; # # Vars for elapsed info # my $elapsed; my @elapsed; # # boolean value for waiting # my $bWait = 0; my $bStart = 0; my $bLocked = 0; my $bPending = 0; # # SQL vars # my $statequery = "select step from joblog where binary title=\"$title\" ". "and binary server=\"$hostname\" order by step desc ". "limit 1"; my $semquery = "select state from semaphores where binary title=". "\"$title\" and binary server=\"$hostname\""; my @sqlarray; my $rc; my $step; my $state; my $numsem; # # Var for sleep interval default to 3 minutes # my $defsleepinterval = 3*60; my $sleepinterval; # # See if we wait until jobs has completed before moving on # my $parallel = $config->PARALLEL; # # Sleep long enough to get job started # _threadlogger("waiting for job to complete"); sleep(30); # # Query step # _threadlogger("running $statequery"); @sqlarray = $os->run_sql_query($statequery, ";"); $rc = @sqlarray; _threadlogger("rc = $rc, sqlarray = $sqlarray[0]"); # # If we got a record and it's not 7 (done) # figure out how long to wait # if ($rc && $sqlarray[0] != 7 && !$parallel) { _threadlogger("Run jobs in order"); # # Get average time to completion for existing job # $isinternal = 1; $elapsed = elapsed('-n', "$title", '-r'); $isinternal = 0; # # Log output for debugging # _threadlogger("$elapsed"); # # Make sure job is running # if ($elapsed !~ /is not currently running/) { $bStart = 1; while ($bStart) { #_threadlogger("spintilldry waiting $defsleepinterval"); sleep($defsleepinterval); #_threadlogger("running state $statequery"); @sqlarray = $os->run_sql_query($statequery); $step = $sqlarray[0]; #_threadlogger("step = $step"); if ($step > 0 && $step < 7) { _threadlogger("running sem $semquery"); @sqlarray = $os->run_sql_query($semquery, ";"); # # If there's more than one entry here there's # a pending lock # $numsem = @sqlarray; # # See if there's a lock pending # if ($numsem == 2) { $bPending = 1; } else { $bPending = 0; } $state = $sqlarray[0]; # _threadlogger("state = $state"); if (!$state) { $bStart = 0; return; } } else { return; if (!$bPending) { _threadlogger("job finished"); $bStart = 0; } } } } } return; } sub _debuglogger { my $string = shift; my $formattime; my $reqtime = scalar localtime; print DEBUGGER "[$reqtime]: $string\n"; } sub _pthreadlogger { my $string = shift; my $formattime; my $reqtime = scalar localtime; print PTHREADLOG "[$reqtime]: $string\n"; } sub _threadlogger { my $string = shift; my $formattime; my $reqtime = scalar localtime; print THREADLOG "[$reqtime]: $string\n"; } sub _requestbuild { my $title = shift; my $sport = $os->sport; my $conn1; _threadlogger("requesting build of $title"); $conn1 = RPC->connect($hostname, $sport); die "Error: Could not connect\n" unless $conn1; $conn1->rpc("build -n $title"); } sub _serverup { my $ServerName = shift; my $sqlquery; my @sqlarray; $sqlquery = "select status from buildservers where binary ". "server=\"$ServerName\""; @sqlarray = $os->run_sql_query($sqlquery, ";"); return $sqlarray[0]; } # # Call this buildserver indirection. # sub _clientcall { my $ServerName = shift; my @ClientCall = @_; my $sqlquery; my @sqlarray; my $conn1; my @msg; my $err; if (_serverup($ServerName)) { $sqlquery = "select port from buildservers where binary ". "server=\"$ServerName\""; @sqlarray = $os->run_sql_query($sqlquery, ";"); $conn1 = RPCStd->connect($ServerName, $sqlarray[0]); if (defined($conn1)) { _logevents("remote call: $ServerName @_", 0); @msg = $conn1->rpc("@ClientCall"); if (defined($err)) { return $err; } else { if (!$isexternal) { unshift @msg, "Response from $ServerName:\n"; } return @msg; } } else { return "can't establish contact with $ServerName"; } } else { return "Server $ServerName is not running"; } } # # 3 routines to generate javascript # sub _do_popupstring { my $webserver = shift; my $server = shift; my $title = shift; my $jobno = shift; return "\"javascript:loadpopup(\'$webserver\',\'$server\',\'$title\', ". "\'$jobno\');\""; } sub _do_popup { my $string = shift; my $title = shift; chomp $string; chomp $title; $string =~ s/\n/\/g; return "onmouseout=kill(); onmouseover=\"pop(\'$string". "\','#B3AFE9',\'$title\'); return false\""; } sub _do_popup2 { my $string = shift; my $title = shift; my @newstring; chomp $title; # $string =~ s/\n/\/g; @newstring = split(/\n/, $string); $string = ""; foreach my $entry (@newstring) { chomp $entry; $string .= "$entry
"; $string =~ s/\r//g; } return "onmouseout=kill(); onmouseover=\"pop(\'$string". "\','#B3AFE9',\'$title\'); return false\""; } # # Rebuild arg list from client since it's # munged by the Msg pkg into a scalar instead # of an array. # sub _parsearray { my @in = @_; my @out = @emptyarray; my $entry; my $concat; my $bstart; my $argfound; foreach $entry (@in) { # # Look for a hyphen to start an entry # if ($entry =~ /^\-/) { if (!$bstart) { $argfound = 1; $bstart = 1; } else { $concat =~ s/ +$//g; if ($concat !~ /^$/) { push @out, $concat; } $concat = ""; $bstart = 0; } if ($argfound && !$bstart) { $bstart = 1; $argfound = 0; } push @out, $entry; } elsif ($entry !~ /^\-/ && $bstart) { $concat .= "$entry "; } elsif ($entry !~ /^\-/ && !$bstart) { push @out, $entry; } } if ($concat !~ /^$/) { $concat =~ s/ +$//g; push @out, "$concat"; } @_ = @emptyarray; return @out; }