#!/usr/bin/perl my $BBMHOME = '/export/home/bbmass'; my $RULEQAURL = 'http://ruleqa.spamassassin.org/'; # where do the reporting scripts get run from? my $REPORTSCRIPTSADIR = "/export/home/automc/svn/spamassassin"; # --------------------------------------------------------------------------- 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 () { # 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 = + 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: $!"; }