tools/tinderbox_build

   1 #!/usr/bin/perl
   2 # tinderbox_build.pl
   3 # This script builds the nagiosplugins and then sends
   4 # logs back to the master tinderbox server
   5 #
   6 # This script is based on mozilla-unix.pl which comes with tinderbox2
   7 #
   8 # See http://tinderbox.altinity.org for more details
   9
  10 require 5.000;
  11
  12 use strict;
  13 use Sys::Hostname;
  14 use Cwd;
  15 use Time::Local;
  16
  17 my $Version = `git describe --abbrev=4 HEAD`;
  18
  19 my $myhost = hostname;
  20 chomp($myhost);
  21 my ($host, $junk) = split(/\./, $myhost);
  22
  23 my $BuildAdministrator = $ENV{TINDERBOX_BUILD_ADMIN} || "$ENV{'USER'}\@$myhost";
  24 my $TmpDir = $ENV{TMPDIR} || "/tmp";
  25
  26 #Default values of cmdline opts
  27 my $ReportStatus = 0;  # Do not send results to server
  28
  29 # Set these to what makes sense for your system
  30
  31 # Set these proper values for your tinderbox server
  32 # Have the StrictHostKeyChecking=no so that a new host will automatically add hostkey without
  33 # prompting. If host key changes, then will get error, so this should still be secure
  34 my $Tinderbox_server = '-p 1022 -o StrictHostKeyChecking=no tinderbox2@tinderbox.opsera.com';
  35
  36 # These shouldn't really need to be changed
  37 my $BuildTree = 'nagiosplug';
  38 my $BuildName = '';
  39 my $ConfigureArgs = $ENV{CONFIGURE_ARGS};
  40
  41 my $OS = `uname -s`;
  42 my $OSVer = `uname -r`;
  43
  44 chop($OS, $OSVer);
  45
  46 if ( $OS eq 'AIX' ) {
  47         $OSVer = `uname -v`;
  48         chop($OSVer);
  49         $OSVer = $OSVer . "." . `uname -r`;
  50         chop($OSVer);
  51 }
  52
  53 if ( $OS eq 'IRIX64' ) {
  54         $OS = 'IRIX';
  55 }
  56
  57 if ( $OS eq 'SCO_SV' ) {
  58         $OS = 'SCOOS';
  59         $OSVer = '5.0';
  60 }
  61
  62 if ( "$host" ne "" ) {
  63         $BuildName = $host . ' ';
  64 }
  65 $BuildName .= $OS . ' ' . $OSVer;
  66 $_ = $BuildName;
  67 s/ /_/g;
  68
  69 my $logfile = "$_.log";
  70
  71 sub BuildIt {
  72         my ($fe, @felist, $EarlyExit, $LastTime);
  73
  74         my $StartDir = getcwd();
  75         $LastTime = 0;
  76
  77         print "Starting dir is : $StartDir\n";
  78
  79         my $EarlyExit = 0;
  80
  81         chdir("$StartDir");
  82
  83         my $StartTime = time;
  84         if (-e (my $file = "nagios-plugins.spec")) {
  85                 open F, $file;
  86                 while (<F>) {
  87                         if (/^Version: trunk-(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
  88                                 $StartTime = timegm(0, $5, $4, $3, ($2 - 1), ($1 - 1900));
  89                                 last;
  90                         }
  91                 }
  92         }
  93
  94         print "Start time is $StartTime",$/;
  95
  96         my $CurrentDir = getcwd();
  97         if ( $CurrentDir ne $StartDir ) {
  98                 print "startdir: $StartDir, curdir $CurrentDir\n";
  99                 die "curdir != startdir";
 100         }
 101
 102         unlink( "$logfile" );
 103
 104         print "opening $logfile\n";
 105         open( LOG, ">$logfile" ) || print "can't open $?\n";
 106         print LOG "current dir is -- $host:$CurrentDir\n";
 107         print LOG "Build Administrator is $BuildAdministrator\n";
 108         &PrintEnv;
 109
 110         my $BuildStatus;
 111         if (&configure) {
 112                 if (&make) {
 113                         if (&maketest) {
 114                                 $BuildStatus = "success";
 115                         } else {
 116                                 $BuildStatus = "test_failed";
 117                         }
 118                 } else {
 119                         $BuildStatus = "build_failed";
 120                 }
 121         } else {
 122                 $BuildStatus = "busted";
 123         }
 124
 125         print LOG "\nBuild Status = $BuildStatus\n";
 126
 127         close(LOG);
 128         chdir("$StartDir");
 129
 130 # TV: Leaving this in, because process mail program probably has some
 131 # limitation retained
 132
 133 # this fun line added on 2/5/98. do not remove. Translated to english,
 134 # that's "take any line longer than 1000 characters, and split it into less
 135 # than 1000 char lines.  If any of the resulting lines is
 136 # a dot on a line by itself, replace that with a blank line."
 137 # This is to prevent cases where a <cr>.<cr> occurs in the log file.  Sendmail
 138 # interprets that as the end of the mail, and truncates the log before
 139 # it gets to Tinderbox.  (terry weismann, chris yeh)
 140 #
 141 # This was replaced by a perl 'port' of the above, writen by
 142 # preed@netscape.com; good things: no need for system() call, and now it's
 143 # all in perl, so we don't have to do OS checking like before.
 144
 145         open(LOG, "$logfile") || die "Couldn't open logfile: $!\n";
 146         open(OUTLOG, ">${logfile}.last") || die "Couldn't open logfile: $!\n";
 147
 148         print OUTLOG $/;
 149         print OUTLOG "tinderbox: tree: $BuildTree\n";
 150         print OUTLOG "tinderbox: builddate: $StartTime\n";
 151         print OUTLOG "tinderbox: status: $BuildStatus\n";
 152         print OUTLOG "tinderbox: build: $BuildName $fe\n";
 153         print OUTLOG "tinderbox: errorparser: unix\n";
 154         print OUTLOG "tinderbox: buildfamily: unix\n";
 155         print OUTLOG "tinderbox: END\n";
 156         print OUTLOG $/;
 157
 158         while (<LOG>) {
 159             my $q = 0;
 160
 161             for (;;) {
 162                 my $val = $q * 1000;
 163                 my $Output = substr($_, $val, 1000);
 164
 165                 last if $Output eq undef;
 166
 167                 $Output =~ s/^\.$//g;
 168                 $Output =~ s/\n//g;
 169                 print OUTLOG "$Output\n";
 170                 $q++;
 171             } #EndFor
 172
 173         } #EndWhile
 174
 175         close(LOG);
 176         close(OUTLOG);
 177
 178         if ($ReportStatus) {
 179                 system( "ssh $Tinderbox_server tinderbox_receive < ${logfile}.last" )
 180         } else {
 181                 print <<"EOF"
 182 Not sending logs to http://tinderbox.altinity.org
 183 If you have SSH keys setup on the tinderbox server, you can manually send
 184 with 'ssh $Tinderbox_server tinderbox_receive < ${logfile}.last'
 185 EOF
 186         }
 187
 188         unlink("$logfile");
 189         print "Finished building for tinderbox",$/;
 190
 191 } #EndSub-BuildIt
 192
 193 sub ParseArgs {
 194     my($i);
 195
 196     $i = 0;
 197     while( $i < @ARGV ) {
 198         if ($ARGV[$i] eq '--version' || $ARGV[$i] eq '-v') {
 199             die "$0: version $Version\n";
 200         } elsif ($ARGV[$i] eq '-y') {
 201                 $ReportStatus = 1;
 202         } else {
 203             &PrintUsage;
 204         }
 205
 206         $i++;
 207     } #EndWhile
 208
 209 } #EndSub-ParseArgs
 210
 211 sub PrintUsage {
 212     die "usage: $0 [-v | --version ] [-t do not send report to tinderbox server]\n";
 213 }
 214
 215 sub PrintEnv {
 216     my ($key);
 217     foreach $key (keys %ENV) {
 218         print LOG "$key = $ENV{$key}\n";
 219         print "$key = $ENV{$key}\n";
 220     }
 221
 222         # Print the NPTest variables
 223         if (-e "/var/tmp/NPTest.cache") {
 224                 open F, "/var/tmp/NPTest.cache";
 225                 print LOG "NPTest variables:\n";
 226                 print LOG <F>;
 227                 close F;
 228         }
 229
 230 } #EndSub-PrintEnv
 231
 232 sub SetupPath {
 233     my($Path);
 234     $Path = $ENV{PATH};
 235     print "Path before: $Path\n";
 236
 237     # Don't alter path if we're building off a repository tree;
 238     # SunOS make will be used only for snapshots and releases.
 239     if ( $OS eq 'SunOS' && !( -e '.svn' || -e '.git' )) {
 240         $ENV{'PATH'} = '/usr/ccs/bin:' . $ENV{'PATH'};
 241     }
 242
 243     $Path = $ENV{PATH};
 244     print "Path After: $Path\n";
 245 } #EndSub-SetupPath
 246
 247 sub configure {
 248         # Configure
 249         print LOG "./configure --enable-extra-opts --enable-libtap $ConfigureArgs 2>&1\n";
 250         open (CONFIGURE, "./configure --enable-extra-opts --enable-libtap $ConfigureArgs 2>&1 |") || die "../configure: $!\n";
 251         while (<CONFIGURE>) {
 252             print $_;
 253             print LOG $_;
 254         }
 255         close(CONFIGURE);
 256         return ! $?;
 257 }
 258
 259 sub make {
 260         # Building
 261         print LOG "make 2>&1\n";
 262         open( MAKE, "make 2>&1 |");
 263         while ( <MAKE> ) {
 264                 print $_;
 265                 print LOG $_;
 266         }
 267         close( MAKE);
 268         return ! $?;
 269 }
 270
 271 sub maketest {
 272         # Tests
 273         print LOG "LANG=C make test 2>&1 && make install DESTDIR=$TmpDir/tinderbox_build.$$ 2>&1 && make install-strip DESTDIR=$TmpDir/tinderbox_build2.$$ 2>&1\n";
 274         open( MAKE, "LANG=C make test 2>&1 && make install DESTDIR=$TmpDir/tinderbox_build.$$ 2>&1 && make install-strip DESTDIR=$TmpDir/tinderbox_build2.$$ 2>&1 |");
 275         while ( <MAKE> ) {
 276                 print $_;
 277                 print LOG $_;
 278         }
 279         close( MAKE);
 280         my $rc = $?;
 281         system("rm -fr $TmpDir/tinderbox_build.$$ $TmpDir/tinderbox_build2.$$");
 282         return ! $rc;
 283 }
 284
 285 # Main function
 286 &ParseArgs;
 287 &SetupPath;
 288 &BuildIt;
 289
 290 1;