summaryrefslogtreecommitdiffstats
path: root/tools/tinderbox_build
blob: 04c691e271904144d9a04169282b01ed90d5040f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
#!/usr/bin/perl
# tinderbox_build.pl
# This script builds the nagiosplugins and then sends
# logs back to the master tinderbox server
#
# This script is based on mozilla-unix.pl which comes with tinderbox2
#
# See http://tinderbox.altinity.org for more details

require 5.000;

use strict;
use Sys::Hostname;
use Cwd;
use Time::Local;

my $Version = `git describe --abbrev=4 HEAD`;

my $myhost = hostname;
chomp($myhost);
my ($host, $junk) = split(/\./, $myhost);
	
my $BuildAdministrator = $ENV{TINDERBOX_BUILD_ADMIN} || "$ENV{'USER'}\@$myhost";
my $TmpDir = $ENV{TMPDIR} || "/tmp";

#Default values of cmdline opts
my $ReportStatus = 0;  # Do not send results to server

# Set these to what makes sense for your system

# Set these proper values for your tinderbox server
# Have the StrictHostKeyChecking=no so that a new host will automatically add hostkey without
# prompting. If host key changes, then will get error, so this should still be secure
my $Tinderbox_server = '-p 1022 -o StrictHostKeyChecking=no tinderbox2@tinderbox.opsera.com';

# These shouldn't really need to be changed
my $BuildTree = 'nagiosplug';
my $BuildName = '';
my $ConfigureArgs = $ENV{CONFIGURE_ARGS};

my $OS = `uname -s`;
my $OSVer = `uname -r`;
    
chop($OS, $OSVer);
    
if ( $OS eq 'AIX' ) {
	$OSVer = `uname -v`;
	chop($OSVer);
	$OSVer = $OSVer . "." . `uname -r`;
	chop($OSVer);
}
        
if ( $OS eq 'IRIX64' ) {
	$OS = 'IRIX';
}
    
if ( $OS eq 'SCO_SV' ) {
	$OS = 'SCOOS';
	$OSVer = '5.0';
}
    
if ( "$host" ne "" ) {
	$BuildName = $host . ' ';
}
$BuildName .= $OS . ' ' . $OSVer;
$_ = $BuildName;
s/ /_/g;

my $logfile = "$_.log";

sub BuildIt {
	my ($fe, @felist, $EarlyExit, $LastTime);

	my $StartDir = getcwd();
	$LastTime = 0;

	print "Starting dir is : $StartDir\n";

	my $EarlyExit = 0;

	chdir("$StartDir");

	my $StartTime = time;
	if (-e (my $file = "nagios-plugins.spec")) {
		open F, $file;
		while (<F>) {
			if (/^Version: trunk-(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
				$StartTime = timegm(0, $5, $4, $3, ($2 - 1), ($1 - 1900));
				last;
			}
		}
	}

	print "Start time is $StartTime",$/;

	my $CurrentDir = getcwd();
	if ( $CurrentDir ne $StartDir ) {
		print "startdir: $StartDir, curdir $CurrentDir\n";
		die "curdir != startdir";
	}

	unlink( "$logfile" );
	
	print "opening $logfile\n";
	open( LOG, ">$logfile" ) || print "can't open $?\n";
	print LOG "current dir is -- $host:$CurrentDir\n";
	print LOG "Build Administrator is $BuildAdministrator\n";
	&PrintEnv;
	
	my $BuildStatus;
	if (&configure) {
		if (&make) {
			if (&maketest) {
				$BuildStatus = "success";
			} else {	
				$BuildStatus = "test_failed";
			}
		} else {
			$BuildStatus = "build_failed";
		}
	} else {
		$BuildStatus = "busted";
	}

	print LOG "\nBuild Status = $BuildStatus\n";

	close(LOG);
	chdir("$StartDir");
	
# TV: Leaving this in, because process mail program probably has some
# limitation retained

# this fun line added on 2/5/98. do not remove. Translated to english,
# that's "take any line longer than 1000 characters, and split it into less
# than 1000 char lines.  If any of the resulting lines is
# a dot on a line by itself, replace that with a blank line."  
# This is to prevent cases where a <cr>.<cr> occurs in the log file.  Sendmail
# interprets that as the end of the mail, and truncates the log before
# it gets to Tinderbox.  (terry weismann, chris yeh)
#
# This was replaced by a perl 'port' of the above, writen by 
# preed@netscape.com; good things: no need for system() call, and now it's
# all in perl, so we don't have to do OS checking like before.

	open(LOG, "$logfile") || die "Couldn't open logfile: $!\n";
	open(OUTLOG, ">${logfile}.last") || die "Couldn't open logfile: $!\n";
	    
	print OUTLOG $/;
	print OUTLOG "tinderbox: tree: $BuildTree\n";
	print OUTLOG "tinderbox: builddate: $StartTime\n";
	print OUTLOG "tinderbox: status: $BuildStatus\n";
	print OUTLOG "tinderbox: build: $BuildName $fe\n";
	print OUTLOG "tinderbox: errorparser: unix\n";
	print OUTLOG "tinderbox: buildfamily: unix\n";
	print OUTLOG "tinderbox: END\n";	    
	print OUTLOG $/;

	while (<LOG>) {
	    my $q = 0;
	    
	    for (;;) {
		my $val = $q * 1000;
		my $Output = substr($_, $val, 1000);
		
		last if $Output eq undef;
		
		$Output =~ s/^\.$//g;
		$Output =~ s/\n//g;
		print OUTLOG "$Output\n";
		$q++;
	    } #EndFor
		
	} #EndWhile
	    
	close(LOG);
	close(OUTLOG);

	if ($ReportStatus) {
		system( "ssh $Tinderbox_server tinderbox_receive < ${logfile}.last" )
	} else {
		print <<"EOF"
Not sending logs to http://tinderbox.altinity.org
If you have SSH keys setup on the tinderbox server, you can manually send
with 'ssh $Tinderbox_server tinderbox_receive < ${logfile}.last'
EOF
	}
	
	unlink("$logfile");
	print "Finished building for tinderbox",$/;

} #EndSub-BuildIt

sub ParseArgs {
    my($i);

    $i = 0;
    while( $i < @ARGV ) {
	if ($ARGV[$i] eq '--version' || $ARGV[$i] eq '-v') {
	    die "$0: version $Version\n";
	} elsif ($ARGV[$i] eq '-y') {
		$ReportStatus = 1;
	} else {
	    &PrintUsage;
	}

	$i++;
    } #EndWhile

} #EndSub-ParseArgs

sub PrintUsage {
    die "usage: $0 [-v | --version ] [-t do not send report to tinderbox server]\n";
}

sub PrintEnv {
    my ($key);
    foreach $key (keys %ENV) {
	print LOG "$key = $ENV{$key}\n";
	print "$key = $ENV{$key}\n";
    }

	# Print the NPTest variables
	if (-e "/var/tmp/NPTest.cache") {
		open F, "/var/tmp/NPTest.cache";
		print LOG "NPTest variables:\n";
		print LOG <F>;
		close F;
	}
		
} #EndSub-PrintEnv

sub SetupPath {
    my($Path);
    $Path = $ENV{PATH};
    print "Path before: $Path\n";

    # Don't alter path if we're building off a repository tree;
    # SunOS make will be used only for snapshots and releases.
    if ( $OS eq 'SunOS' && !( -e '.svn' || -e '.git' )) {
        $ENV{'PATH'} = '/usr/ccs/bin:' . $ENV{'PATH'};
    }

    $Path = $ENV{PATH};
    print "Path After: $Path\n";
} #EndSub-SetupPath

sub configure {
	# Configure
        print LOG "./configure --enable-extra-opts --enable-libtap $ConfigureArgs\n";
        open (CONFIGURE, "./configure --enable-extra-opts --enable-libtap $ConfigureArgs 2>&1 |") || die "../configure: $!\n";
        while (<CONFIGURE>) {
            print $_;
            print LOG $_;
        }
        close(CONFIGURE);
	return ! $?;
}
	
sub make {
        # Building
        print LOG "make 2>&1\n";
        open( MAKE, "make 2>&1 |");
	while ( <MAKE> ) {
		print $_;
		print LOG $_;
	}
	close( MAKE);
	return ! $?;
}

sub maketest {
        # Tests
        print LOG "LANG=C make test 2>&1\n";
        open( MAKE, "LANG=C make test && make install DESTDIR=$TmpDir/tinderbox_build.$$ && make install-strip DESTDIR=$TmpDir/tinderbox_build2.$$ 2>&1 |");
	while ( <MAKE> ) {
		print $_;
		print LOG $_;
	}
	close( MAKE);
	my $rc = $?;
	system("rm -fr $TmpDir/tinderbox_build.$$ $TmpDir/tinderbox_build2.$$");
	return ! $rc;
}

# Main function
&ParseArgs;
&SetupPath;
&BuildIt;

1;