build/automc/buildbot_ready

#!/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: $!";
}