Devel-Tinderclient-1.4/Tinderconfig.pm0000644000076500007650000002011607732503425016465 0ustar zachzach# 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 # # 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/0000755000076500007650000000000007446725112015605 5ustar zachzachDevel-Tinderclient-1.4/Tindermail/Http.pm0000755000076500007650000000651507446725112017074 0ustar zachzach# 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 # # 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.pm0000755000076500007650000000647307446720030020166 0ustar zachzach# 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 # # 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.pm0000755000076500007650000000751007445740104017702 0ustar zachzach# 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 # # 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.pl0000755000076500007650000001616710630076623016061 0ustar zachzach#!/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 # # 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 () { # 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();