Devel-Tinderclient-1.4/Tinderconfig.pm 0000644 0000765 0000765 00000020116 07732503425 016465 0 ustar zach zach # Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is The Tinderbox Client.
#
# The Initial Developer of the Original Code is
# Zach Lipton.
# Portions created by the Initial Developer are Copyright (C) 2002
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Zach Lipton <zach@zachlipton.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
# This script developed August 2001 for Abisource and perl.
package Tinderconfig;
# By forcing us into a seperate package, we can keep ourselves out # of the namespace of the main script. This way, when invoking config # vars, it must be called like $Tinderconfig::var instead of $var;
===========================================================
BOXNAME
# set this to the name of the tinderbox that you wish to
# see displayed as the col. heading on the tinderbox server.
# This should probably contain your OS.
$boxname = "";
#===========================================================
===========================================================
MAILSYSTEM
# Tinderbox currently supports several sustems for mail to the
# tinderbox server. Please select which you wish to use.
# Vaild options are: Tindermail::Sendmail (the default old mail system),
# Tindermail::MailMailer (requires the Mail::Mailer module and Net::SMTP)
# or Tindermail::Http (recomended, requires LWP and a tinderbox server
# that supports Http input, currently only tinderbox.perl.org)
$mailsystem = "Tindermail::Http";
#===========================================================
===========================================================
MAILSERVER
# If you have selected Tindermail::MailMailer above, please select
# the smtp server that you plan to use (such as mail.mycompany.com).
$mailserver = "";
#===========================================================
===========================================================
SERVERADDRESS
# set this to the email address that the results should be sent
# to.
$serveraddress = 'tinder@onion.perl.org';
#===========================================================
===========================================================
TINDERBOXPAGE
# set this to the page on the tinderbox (SeaMonkey, MozillaTest,
# etc) that you wish to display this tinderboxen.
$tinderboxpage = "parrot";
#===========================================================
===========================================================
ADMIN
# set this to the email address of the person who should
# get trouble reports
$admin = '';
#===========================================================
===========================================================
CVSROOT
# set this to the cvsroot you wish to use
# note that you must have cvs logged in once with the unix account
# that you will be using to power the tinderbox to get a
# ~/.cvsroot file created.
$cvsroot = ':pserver:anonymous@cvs.perl.org:/cvs/public';
#===========================================================
===========================================================
CVSMODULE
# set this to the module that you would like the tinderbox
# client script to pull. If you use a script to pull, then
# set this to the script so that it can be downloaded from
# the server and set $prebuild so it will be run to do the
# complete pull. The script should handle everything related to
# pulling.
$cvsmodule = "parrot";
#===========================================================
===========================================================
PULLDIR
# Set this var to the directory that the source will be once
# the pull is complete. For example, if you are checking out
# a module with the full path of mozilla/webtools/bugzilla,
# you would enter that here. It is important that you enter
# a correct value here, or the script will fail.
# Please ensure that you insert the value in the "" quotes
# and not in the single quotes.
$pulldir = './'."parrot";
#===========================================================
===========================================================
PREBUILD
# This var should be set to a script (if any) that you would
# like run before the build, but after the pull. For example,
# if you have a script which you checkout of cvs, and then run
# to do the full pull, you would enter that here and the full
# cvs path to the script in $CVSMODULE above. Note that this
# script runs in the cvs tree directory.
$prebuild = "";
#===========================================================
===========================================================
BUILDCOMMANDS
# This array should be set to the commands needed to build.
# The commands will be run in sequence starting with [0].
@buildcommands = ('perl Configure.pl --defaults','make clean','make');
#===========================================================
===========================================================
FAILURESTATES
# This should be set to a list of rexexp patterns that will
# indicate an error building the source. Be carful with this,
# as if the pattern matches any output with the build it will
# show up as a failure on the tinderbox page.
@failurestates = ('\[checkout aborted\]','\: cannot find module','^C ','Stop in');
#===========================================================
===========================================================
TESTS
# This hash should be set to the commands to run to perform the
# test as the key, and an array of two regexp patterns that
# indicate a PASS of the test, and a build failure,
# in that order. It will be considered a test failed if the
# none of the regexps match. If the second regexp is blank,
# the failure of this test will not be able to result in a
# burning tree on tinderbox. Having anything in the build
# error regexp at all is mostly useful for Perl programs,
# where the same compile test determines both build errors
# and test failures.
%tests = (
# 'COMMAND' => ['PASS','FAILURE'],
'make test' => ['All tests successful',''],
);
#===========================================================
===========================================================
POSTBUILD
# This array should be set to commands (if any) that should
# be run after the build. For example, if you would like to
# upload the build to an ftp site, you can set this to a
# packaging script and/or a shell script to do the upload.
@postbuild = ();
#===========================================================
===========================================================
MINCYCLETIME
# This should be set to the minimum time between tinderbox
# test cycles. This is to avoid overloading the server
# with lots of closely-spaced emails. If the build and
# test process takes longer than this amount of time, the
# build and test process will restart immediately, however
# if it takes less, it will wait until this time has
# expired before restarting.
$mincycletime = 300;
#===========================================================
$cvs = 1; # we are using cvs and not rsync here
1;
Devel-Tinderclient-1.4/Tindermail/ 0000755 0000765 0000765 00000000000 07446725112 015605 5 ustar zach zach Devel-Tinderclient-1.4/Tindermail/Http.pm 0000755 0000765 0000765 00000006515 07446725112 017074 0 ustar zach zach # Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is The Tinderbox Client.
#
# The Initial Developer of the Original Code is
# Zach Lipton.
# Portions created by the Initial Developer are Copyright (C) 2002
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Zach Lipton <zach@zachlipton.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
package Tindermail::Http;
use Exporter;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
@ISA = qw(Exporter);
@EXPORT = qw (sendstartmail sendendmail);
use Tinderconfig;
1;
sub sendstartmail {
$time = time();
$uastart = LWP::UserAgent->new;
$uastart->agent("Tinderbox Client (zach\@zachlipton.com)");
my $body = "";
$body .= "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
$body .= "tinderbox: builddate: $time\n";
$body .= "tinderbox: status: building\n";
$body .= "tinderbox: build: $Tinderconfig::boxname\n";
$body .= "tinderbox: errorparser: unix\n";
$body .= "tinderbox: buildfamily: unix\n";
$body .= "tinderbox: START\n";
my $req = POST 'http://tinderbox.perl.org/tinderbox/gettinderdata.cgi',
[message => $body];
print $uastart->request($req)->as_string;
}
sub sendendmail {
($log, $state) = @_; # state is pass, fail, testfailed
my $newmailer;
my $endbody = "";
$uaend = LWP::UserAgent->new;
$uaend->agent("Tinderbox Client (zach\@zachlipton.com)");
$endbody .= "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
$endbody .= 'tinderbox: builddate: '.$time."\n";
if ($state eq "pass") {
$endbody .= "tinderbox: status: success\n";
} elsif ($state eq "fail") {
$endbody .= "tinderbox: status: busted\n";
} elsif ($state eq "testfailed") {
$endbody .= "tinderbox: status: testfailed\n";
} else {
$endbody .= "tinderbox: status: busted\n"; # something nuts happend
}
$endbody .= "tinderbox: build: $Tinderconfig::boxname\n";
$endbody .= "tinderbox: errorparser: unix\n";
$endbody .= "tinderbox: buildfamily: unix\n";
$endbody .= "tinderbox: END\n\n";
$endbody .= $log; # output our build log
my $req = POST 'http://tinderbox.perl.org/tinderbox/gettinderdata.cgi',
[message => $endbody];
print $uaend->request($req)->as_string;
} Devel-Tinderclient-1.4/Tindermail/MailMailer.pm 0000755 0000765 0000765 00000006473 07446720030 020166 0 ustar zach zach # Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is The Tinderbox Client.
#
# The Initial Developer of the Original Code is
# Zach Lipton.
# Portions created by the Initial Developer are Copyright (C) 2002
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Zach Lipton <zach@zachlipton.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
package Tindermail::MailMailer;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw (sendstartmail sendendmail);
use Tinderconfig;
use Mail::Mailer;
%headers = (
'From' => 'tinderbox-client@zachlipton.com',
'To' => $Tinderconfig::serveraddress,
'Subject' => 'Tinderbox',
);
1;
sub sendstartmail {
$time = time();
my $mailer = new Mail::Mailer 'smtp', Server => $Tinderconfig::mailserver;
$mailer->open(\%headers);
my $body = ""
$body .= "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
$body .= "tinderbox: builddate: $time\n";
$body .= "tinderbox: status: building\n";
$body .= "tinderbox: build: $Tinderconfig::boxname\n";
$body .= "tinderbox: errorparser: unix\n";
$body .= "tinderbox: buildfamily: unix\n";
$body .= "tinderbox: START\n";
print $mailer $body;
$mailer->close();
$mailer = "";
}
sub sendendmail {
($log, $state) = @_; # state is pass, fail, testfailed
my $newmailer;
my $endbody = "";
$newmailer = new Mail::Mailer 'smtp', Server => $Tinderconfig::mailserver;
$newmailer->open(\%headers);
print $newmailer "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
print $newmailer 'tinderbox: builddate: '.$time."\n";
if ($state eq "pass") {
print $newmailer "tinderbox: status: success\n";
} elsif ($state eq "fail") {
print $newmailer "tinderbox: status: busted\n";
} elsif ($state eq "testfailed") {
print $newmailer "tinderbox: status: testfailed\n";
} else {
print $newmailer "tinderbox: status: busted\n"; # something nuts happend
}
print $newmailer "tinderbox: build: $Tinderconfig::boxname\n";
print $newmailer "tinderbox: errorparser: unix\n";
print $newmailer "tinderbox: buildfamily: unix\n";
print $newmailer "tinderbox: END\n\n";
print $newmailer $log; # output our build log
$newmailer->close();
} Devel-Tinderclient-1.4/Tindermail/Sendmail.pm 0000755 0000765 0000765 00000007510 07445740104 017702 0 ustar zach zach # Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is The Tinderbox Client.
#
# The Initial Developer of the Original Code is
# Zach Lipton.
# Portions created by the Initial Developer are Copyright (C) 2001
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Zach Lipton <zach@zachlipton.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
# This script developed August 2001 for Abisource and perl.
package Tindermail::Sendmail;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw (sendstartmail sendendmail);
use Tinderconfig;
1;
sub sendstartmail { # to send the start email.
$time = time();
open(SENDMAIL, "|/usr/lib/sendmail -t") ||
die "can't open sendmail"; # get sendmail open
print SENDMAIL "From: tinderbox-client\@zachlipton.com\n";
print SENDMAIL "To: ".$Tinderconfig::serveraddress."\n";
print SENDMAIL "Subject: Tinderbox\n\n";
print SENDMAIL "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
print SENDMAIL 'tinderbox: builddate: '.$time."\n";
print SENDMAIL "tinderbox: status: building\n";
print SENDMAIL "tinderbox: build: $Tinderconfig::boxname\n";
print SENDMAIL "tinderbox: errorparser: unix\n";
print SENDMAIL "tinderbox: buildfamily: unix\n";
print SENDMAIL "tinderbox: START\n";
close(SENDMAIL); # my work here is done.
}
sub sendendmail($$) {
($log, $state) = @_; # state is pass, fail, testfailed
open(SENDMAIL, "|/usr/lib/sendmail -t") ||
die "can't open sendmail"; # get sendmail open
print SENDMAIL "From: tinderbox-client\@zachlipton.com\n";
print SENDMAIL "To: ".$Tinderconfig::serveraddress."\n";
print SENDMAIL "Subject: Tinderbox\n\n";
print SENDMAIL "tinderbox: tree: $Tinderconfig::tinderboxpage\n";
print SENDMAIL 'tinderbox: builddate: '.$time."\n";
if ($state eq "pass") {
print SENDMAIL "tinderbox: status: success\n";
} elsif ($state eq "fail") {
print SENDMAIL "tinderbox: status: busted\n";
} elsif ($state eq "testfailed") {
print SENDMAIL "tinderbox: status: testfailed\n";
} else {
print SENDMAIL "tinderbox: status: busted\n"; # something nuts happend
}
print SENDMAIL "tinderbox: build: $Tinderconfig::boxname\n";
print SENDMAIL "tinderbox: errorparser: unix\n";
print SENDMAIL "tinderbox: buildfamily: unix\n";
print SENDMAIL "tinderbox: END\n\n";
print SENDMAIL $log; # output our build log
close(SENDMAIL); # and send the mail out
}
1;
Devel-Tinderclient-1.4/tinderbox.pl 0000755 0000765 0000765 00000016167 10630076623 016061 0 ustar zach zach #!/usr/bin/perl -w
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is The Tinderbox Client.
#
# The Initial Developer of the Original Code is
# Zach Lipton.
# Portions created by the Initial Developer are Copyright (C) 2002
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Zach Lipton <zach@zachlipton.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
# This script developed August 2001 for Abisource and perl.
use Tinderconfig;
eval "use $Tinderconfig::mailsystem";
if ($@) {
die "Error loading mail backend: $@";
}
use strict;
use subs qw( checkerrors restart sendstartmail );
sendstartmail(); #send the mail that says we are underway
my $starttime = time();
my $testfailed = 0;
my $log = "";
sub Log(\$$) { # pass a ref to a string, and a string, string gets concatonated to the referenced string, and output to stdout.
my $log = shift;
my $str = shift;
$$log .= $str;
print "$str";
return;
}
if ($Tinderconfig::cvs) { $ENV{CVSROOT} = $Tinderconfig::cvsroot; } # set the CVSROOT env var. Log($log,"Starting tinderbox session...\n\n"); Log($log,"machine administrator is $Tinderconfig::admin\n"); Log($log,"tinderbox version is 1.4 modelevel: Devel::Tinderclient\n");
Log($log,"perl cvs mode enabled\n") if $Tinderconfig::cvs eq '1'; Log($log,"perl rsync mode enabled\n") if $Tinderconfig::rsync eq '1'; Log($log,"rsync info = $Tinderconfig::rsynccommand\n");
Log($log,"please address all issues with this client to zach\@zachlipton.com\n"); Log($log,"Dumping env vars...\n");
foreach my $key (keys(%ENV))
{
Log($log,"$key = $ENV{$key}\n");
}
Log($log,"env vars dumped...\n\n");
if ($Tinderconfig::cvs) {
Log($log,"about to cvs checkout $Tinderconfig::cvsmodule:\n");
Log($log,`cvs -z3 co $Tinderconfig::cvsmodule 2>&1`); # do the checkout
Log($log,"cvs checkout complete\n\n");
}
if ($Tinderconfig::rsync) { #handle the rsync pull
unless ($Tinderconfig::pulldir) {
failure('$pulldir unset!\n'); # yell! ASSERT! BAD BAD BAD!
}
unlink($Tinderconfig::pulldir); # get rid of it
system("mkdir $Tinderconfig::pulldir");
chdir("$Tinderconfig::pulldir"); # move into place
system("$Tinderconfig::rsynccommand"); # do the actual pull
}
checkerrors($log); # see if we had any issues pulling
my $dir = `pwd` || failure($!);
chomp($dir);
if ($Tinderconfig::cvs) {
chdir("$Tinderconfig::pulldir") || failure($!); # move into place }
if ($Tinderconfig::prebuild) {
Log($log,"about to run prebuild task $Tinderconfig::prebuild:\n");
Log($log,`$Tinderconfig::prebuild 2>&1`); # do any prebuild tasks we have
Log($log,"Prebuild tasks complete\n\n");
}
checkerrors($log); # and did anything go wrong?
foreach my $command (@Tinderconfig::buildcommands) { # do the build
Log($log,"About to run build command: $command\n");
Log($log,`$command 2>&1`);
checkerrors($log); # yes, all this error checking is REALLY going to have a
# perf impact. I'll look into fixing this soon.
# Basically, we need to cache the log output into a temp var and just # check that, dumping the temp var into the full log.
Log($log,"$command complete\n\n"); }
foreach my $test (keys(%Tinderconfig::tests)) {
Log($log,"About to run test: $test:\n");
my $successregexp = ${$Tinderconfig::tests{$test}}[0];
my $builderrorregexp = ${$Tinderconfig::tests{$test}}[1];
open TEST,"$test 2>&1 |";
my $tmp = "";
while (<TEST>) { # we'll do it this way so we can get the
$tmp .= $_; # output as it comes in if you're watching console
Log($log,$_);
}
close TEST;
if (!$tmp) {
$testfailed = 1;
Log($log,"test did not have any output\n\n");
} elsif ($builderrorregexp && ($tmp =~ m/$builderrorregexp/i)) { # compile error
Log($log,"$test complete\n");
Log($log,"$test found FATAL compile errors\n\n");
failure("Fatal compile errors found");
} elsif ($tmp =~ m/$successregexp/i) { # success!
Log($log,"$test complete\n");
Log($log,"$test passed\n\n");
} else { # it failed
$testfailed = 1;
Log($log,"$test complete\n");
Log($log,"$test FAILED!\n\n");
}
}
if (@Tinderconfig::postbuild) {
foreach my $command (@Tinderconfig::postbuild) {
Log($log,"about to do postbuild command: $command\n");
Log($log,`$command 2>&1`);
checkerrors($log); # here we go again...
Log($log,"$command complete.\n\n");
}
} else {
Log($log,"No postbuild steps defined\n\n");
}
checkerrors($log); # one last time, just to be safe...
if ($testfailed) {
sendendmail($log, "testfailed"); } else {
sendendmail($log, "pass");
}
restart();
sub failure {
Log($log,$_[0]); # add the latest info to the log (if any)
sendendmail($log,'fail'); # send the failure email
restart(); # and give it another go
}
sub checkerrors {
my $log = shift;
foreach my $currentstate (@Tinderconfig::failurestates) { # go through the failurestates
if ($log =~ m/$currentstate/i) { # if we hit one
failure("fatal error: The following error trigger was found: ".$currentstate."\n"); # go away
}
}
}
sub restart {
sleep(1); #give things a little time to process through the mail system
chdir($dir); # it doesn't matter if this fails, all the same.
my $timetaken = (time() - $starttime);
if ($timetaken < $Tinderconfig::mincycletime) { # wait for cycle time to expire
my $sleeptime = $Tinderconfig::mincycletime - $timetaken;
print "Sleeping $sleeptime seconds...\n";
sleep($sleeptime);
}
exec("$0");
exit();
}
exec("$0");
exit();