| #!/usr/bin/perl |
| |
| my $BBMHOME = '/export/home/bbmass'; |
| my $RULEQAURL = 'https://ruleqa.spamassassin.org/'; |
| |
| # where do the reporting scripts get run from? |
| my $REPORTSCRIPTSADIR = "/export/home/svn-trunk"; |
| |
| # --------------------------------------------------------------------------- |
| |
| use strict; |
| use warnings; |
| sub run; |
| |
| # directory used to lock between slaves; no longer used |
| my $LOCKDIR = "/not/in/use"; |
| my $got_lock = undef; |
| |
| $|=1; |
| my $perl = $^X; |
| if (!$perl) { |
| die "no perl path found in ARGV!"; |
| } |
| |
| my $command = shift @ARGV; |
| |
| if ($command eq 'start') { |
| do_start(); |
| } |
| elsif ($command eq 'stop') { |
| do_stop(); |
| } |
| exit; |
| |
| # --------------------------------------------------------------------------- |
| |
| sub do_start { |
| # ensure all pre-reqs (and rules) are built |
| system ("$perl Makefile.PL < /dev/null"); |
| system ("make"); |
| |
| # for mass-check to report, without having to have a working "svn" client |
| # in the chroot |
| |
| # --non-interactive not on the zone yet. duh! |
| # system ("svn info --non-interactive > masses/svninfo.tmp"); |
| system ("svn info > masses/svninfo.tmp < /dev/null"); |
| } |
| |
| # --------------------------------------------------------------------------- |
| |
| sub do_stop { |
| my $rev = get_current_svn_revision(); |
| my $slave = get_current_slave_name(); |
| |
| use POSIX qw(strftime); |
| my $daterev = strftime("%Y%m%d", gmtime(time)) . "-r$rev-b"; |
| my $rurl = $RULEQAURL.$daterev; |
| |
| chdir("masses") or die; |
| |
| print "REPORTS\n\n"; |
| print "Rule-QA results from this mass-check will be published at\n\n"; |
| print " $rurl\n\n"; |
| print "QUICK FREQS REPORT (this mass-check only):\n\n"; |
| |
| system ("$perl hit-frequencies -c tstrules -x -p -T -s 0 > ../freqs"); |
| system ("cat ../freqs"); |
| system ("( cd .. ; ". |
| "$perl ./build/automc/mail_freqs_for_changed_rules '$rurl' freqs )"); |
| |
| print "\n\nBUILDING SLOW REPORTS:\n\n"; |
| |
| my $logdir = "$BBMHOME/tmp/logs-r$rev"; |
| if (!-d $logdir) { |
| run ("mkdir $logdir"); |
| } |
| run ("mv ham.log $logdir/ham-$slave.log"); |
| run ("mv spam.log $logdir/spam-$slave.log"); |
| |
| my $hname = `uname -n`; |
| |
| if ($hname =~ /spamassassin2/) { |
| # need to transfer the logs (using ssh+tar+gz), then run script |
| run ("( cd $BBMHOME ; ". |
| "/usr/sfw/bin/gtar cfz - tmp/logs-r$rev | ". |
| "ssh bbmass\@spamassassin.zones.apache.org /usr/sfw/bin/gtar xvfz - )"); |
| |
| run ("ssh bbmass\@spamassassin.zones.apache.org ". |
| "$REPORTSCRIPTSADIR/build/automc/post_mc_proc_logs $logdir $slave"); |
| } |
| else { |
| # run our script to process those logs |
| run ("$REPORTSCRIPTSADIR/build/automc/post_mc_proc_logs $logdir $slave"); |
| } |
| } |
| |
| # --------------------------------------------------------------------------- |
| |
| sub get_current_svn_revision { |
| open (SVNINFO, "(svn info --non-interactive rulesrc || svn info rulesrc ) < /dev/null 2>&1 |"); |
| |
| # note: use 'Last Changed Rev' instead of 'Revision'. Because we share |
| # an SVN repository with other projects, this means that the same |
| # rev of *our* codebase may appear under multiple rev#s, as other projects |
| # check their changes in. |
| |
| my $revision; |
| while (<SVNINFO>) { |
| # Last Changed Rev: 332684 |
| next unless /^Last Changed Rev: (\d+)/; |
| $revision = $1; |
| last; |
| } |
| close SVNINFO; |
| return $revision if $revision; |
| } |
| |
| sub run { |
| my ($cmd, $ignoreexit) = @_; |
| |
| print "[$cmd]\n"; |
| system ($cmd); |
| |
| if (!$ignoreexit) { |
| die "command '$cmd' failed with status $?" if (($? >> 8) != 0); |
| } |
| } |
| |
| sub get_current_slave_name { |
| my $pwd = `pwd`; |
| $pwd =~ /\/slaves\/([^\/]+)\// and return $1; |
| warn "cannot work out slave name from $pwd"; |
| return "unknown"; |
| } |
| |
| |
| sub try_get_exclusive_lock { |
| if (!-d $LOCKDIR) { |
| print "singleton lock: $LOCKDIR does not exist, so no locking is required.\n"; |
| return 1; |
| } |
| if (!-w $LOCKDIR) { |
| die "cannot write to $LOCKDIR"; |
| } |
| |
| $got_lock = undef; |
| my $newf = $LOCKDIR."/singleton_lock.active"; |
| if (-f $newf) { |
| open (IN, "<$newf"); |
| my $pid = <IN> + 0; close IN; |
| |
| if ($pid > 0 && kill(0, $pid)) { |
| print "singleton lock: locked by $pid, still active.\n"; |
| return 0; |
| } |
| else { |
| print "singleton lock: locked by $pid, no longer active. killing lock\n"; |
| # should have to do this too often, which is just as well, as there's |
| # a tiny little racelet here |
| unlink $newf; |
| } |
| } |
| |
| my $tmpf = $LOCKDIR."/singleton_lock.new.$$"; |
| open (OUT, ">$tmpf") or die "cannot write to $tmpf"; |
| print OUT $$; |
| close OUT or die "cannot write to $tmpf"; |
| |
| if (!-f $newf && rename($tmpf, $newf)) { |
| print "singleton lock: taking\n"; |
| $got_lock = $newf; |
| return 1; |
| } |
| else { |
| print "singleton lock: missed the lock\n"; |
| unlink $tmpf; |
| return 0; |
| } |
| } |
| |
| sub kill_lock { |
| return unless $got_lock; |
| unlink $got_lock or warn "singleton lock: unlink $got_lock failed: $!"; |
| } |