Say hello to Tinderbox 2.0, the choice of a new generation!

2 files changed, 446 insertions, 0 deletions

diff --git a/tools/tools/tinderbox/Makefile b/tools/tools/tinderbox/Makefile
new file mode 100644
index 0000000..1f6119c
--- /dev/null
+++ b/tools/tools/tinderbox/Makefile
@@ -0,0 +1,8 @@
+# $FreeBSD$
+
+BINDIR		?= ${HOME}/bin
+BINOWN		?= ${USER}
+BINGRP		?= ${USER}
+SCRIPTS		 = tinderbox.pl
+
+.include <bsd.prog.mk>
diff --git a/tools/tools/tinderbox/tinderbox.pl b/tools/tools/tinderbox/tinderbox.pl
new file mode 100644
index 0000000..8716854
--- /dev/null
+++ b/tools/tools/tinderbox/tinderbox.pl
@@ -0,0 +1,438 @@
+#!/usr/bin/perl -Tw
+#-
+# Copyright (c) 2003 Dag-Erling Coïdan Smørgrav
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer
+#    in this position and unchanged.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. The name of the author may not be used to endorse or promote products
+#    derived from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+# $FreeBSD$
+#
+
+use strict;
+use Fcntl qw(:DEFAULT :flock);
+use POSIX;
+use Getopt::Long;
+
+my $VERSION	= "2.0";
+my $COPYRIGHT	= "Copyright (c) 2003 Dag-Erling Smørgrav. " .
+		  "All rights reserved.";
+
+my $arch;			# Target architecture
+my $branch;			# CVS branch to checkou
+my $clean;			# Clean before building
+my $date;			# Date of sources to check out
+my $jobs;			# Number of paralell jobs
+my $logfile;			# Path to log file
+my $machine;			# Target machine
+my $repository;			# Location of CVS repository
+my $sandbox;			# Location of sandbox
+my $update;			# Update sources before building
+my $verbose;			# Verbose mode
+
+my %cmds = (
+    'world'	=> 0,
+    'generic'	=> 0,
+    'lint'	=> 0
+);
+
+sub message(@) {
+
+    my $msg = join(' ', "TB ***", @_);
+    chomp($msg);
+    print("$msg\n");
+}
+
+sub warning(@) {
+
+    my $msg = join(' ', @_);
+    chomp($msg);
+    warn("$msg\n");
+    return undef;
+}
+
+sub error(@) {
+
+    my $msg = join(' ', "ERROR:", @_);
+    chomp($msg);
+    die("$msg\n");
+    return undef;
+}
+
+#
+# Open and lock a file reliably
+#
+sub open_locked($;$$) {
+    my $fn = shift;		# File name
+    my $flags = shift;		# Open flags
+    my $mode = shift;		# File mode
+
+    local *FILE;		# File handle
+    my (@sb1, @sb2);		# File status
+
+    for (;; close(FILE)) {
+	sysopen(FILE, $fn, $flags || O_RDONLY, $mode || 0640)
+	    or last;
+	if (!(@sb1 = stat(FILE))) {
+	    # Huh? shouldn't happen
+	    warning("$fn: stat(): $!");
+	    last;
+	}
+	if (!flock(FILE, LOCK_EX|LOCK_NB)) {
+	    # A failure here means the file can't be locked, or
+	    # something really weird happened, so just give up.
+	    warning("$fn: flock(): $!");
+	    last;
+	}
+	if (!(@sb2 = stat($fn))) {
+	    # File was pulled from under our feet, though it may
+	    # reappear in the next pass
+	    next;
+	}
+	if ($sb1[0] != $sb2[0] || $sb1[1] != $sb2[1]) {
+	    # File changed under our feet, try again
+	    next;
+	}
+	return *FILE{IO};
+    }
+    close(FILE);
+    return undef;
+}
+
+#
+# Remove a directory and all its subdirectories
+#
+sub remove_dir($);
+sub remove_dir($) {
+    my $dir = shift;
+
+    if (!-d $dir) {
+	message("removing $dir")
+	    if ($verbose);
+	return (unlink($dir) || $! == ENOENT);
+    }
+
+    local *DIR;
+    opendir(DIR, $dir)
+	or return warning("$dir: $!");
+    foreach my $ent (readdir(DIR)) {
+	next if ($ent eq '.' || $ent eq '..');
+	$ent =~ m/(.*)/;
+	if (!remove_dir("$dir/$1")) {
+	    closedir(DIR);
+	    return undef;
+	}
+    }
+    closedir(DIR)
+	or return warning("$dir: $!");
+    return rmdir($dir);
+}
+
+sub make_dir($);
+sub make_dir($) {
+    my $dir = shift;
+
+    if (!-d $dir && $dir =~ m|^(\S*)/([^\s/]+)$|) {
+	make_dir($1)
+	    or return undef;
+	message("creating $dir")
+	    if ($verbose);
+	mkdir("$dir")
+	    or return undef;
+    }
+    return 1;
+}
+
+sub cd($) {
+    my $dir = shift;
+
+    message("cd $dir")
+	if ($verbose);
+    chdir($dir)
+	or error("$dir: $!");
+}
+
+#
+# Spawn a child and wait for it to finish
+#
+sub spawn($@) {
+    my $cmd = shift;		# Command to run
+    my @args = @_;		# Arguments
+
+    message($cmd, @args)
+	if ($verbose);
+    my $pid = fork();
+    if (!defined($pid)) {
+	return warning("fork(): $!");
+    } elsif ($pid == 0) {
+	exec($cmd, @args);
+	die("child: exec(): $!\n");
+    }
+    if (waitpid($pid, 0) == -1) {
+	return warning("waitpid(): $!");
+    } elsif ($? & 0xff) {
+	return warning("$cmd caught signal", $? & 0x7f);
+    } elsif ($? >> 8) {
+	return warning("$cmd returned exit code", $? >> 8);
+    }
+    return 1;
+}
+
+sub make($) {
+    my $target = shift;
+
+    return spawn('/usr/bin/make',
+	($jobs > 1) ? "-j$jobs" : "-B",
+	$target);
+}
+
+sub logstage($) {
+    my $msg = shift;
+
+    chomp($msg);
+    print(STDERR "TB ", "*"x74, "\n");
+    print(STDERR strftime("TB *** %Y-%m-%d %H:%M:%S - $msg\n", localtime()));
+    print(STDERR "TB ", "*"x74, "\n");
+}
+
+sub sigwarn {
+
+    logstage(shift);
+}
+
+sub sigdie {
+
+    logstage(shift);
+    logstage("tinderbox aborted");
+    exit(1);
+}
+
+sub usage() {
+
+    print(STDERR "This is the FreeBSD tinderbox script, version $VERSION.
+$COPYRIGHT
+
+Usage:
+  $0 [options] [parameters] command [...]
+
+Options:
+  -c, --clean                   Clean sandbox before building
+  -u, --update                  Update sources before building
+  -v, --verbose                 Verbose mode
+
+Parameters:
+  -a, --arch=ARCH               Target architecture
+  -b, --branch=BRANCH           CVS branch to check out
+  -d, --date=DATE               Date of sources to check out
+  -j, --jobs=NUM                Maximum number of paralell jobs
+  -l, --logfile=FILE            Path to log file
+  -r, --repository=DIR          Location of CVS repository
+  -s, --sandbox=DIR             Location of sandbox
+
+Commands:
+  world                         Build the world
+  generic                       Build the GENERIC kernel
+  lint                          Build the LINT kernel
+
+Report bugs to <des\@freebsd.org>.
+");
+    exit(1);
+}
+
+MAIN:{
+    $ENV{'PATH'} = '';
+
+    # Set defaults
+    $arch = `/usr/bin/uname -m`;
+    chomp($arch);
+    $branch = "HEAD";
+    $jobs = 0;
+    $repository = "/home/ncvs";
+    $sandbox = "$ENV{'HOME'}/tinderbox";
+
+    # Get options
+    {Getopt::Long::Configure("auto_abbrev", "bundling");}
+    GetOptions(
+	"a|arch=s"	        => \$arch,
+	"b|branch=s"		=> \$branch,
+	"c|clean"		=> \$clean,
+	"d|date=s"		=> \$date,
+	"j|jobs=i"		=> \$jobs,
+	"l|logfile=s"		=> \$logfile,
+	"m|machine=s"		=> \$machine,
+	"r|repository=s"	=> \$repository,
+	"s|sandbox=s"		=> \$sandbox,
+	"u|update"		=> \$update,
+	"v|verbose"		=> \$verbose,
+	) or usage();
+
+    if ($jobs < 0) {
+	error("invalid number of jobs");
+    }
+    if ($branch !~ m|^(\w+)$|) {
+	error("invalid source branch");
+    }
+    $branch = $1;
+    if ($arch !~ m|^(\w+)$|) {
+	error("invalid target architecture");
+    }
+    $arch = $1;
+    if (!defined($machine)) {
+	$machine = $arch;
+    }
+    if ($machine !~ m|^(\w+)$|) {
+	error("invalid target machine");
+    }
+    $machine = $1;
+    if (!defined($logfile)) {
+	$logfile = "tinderbox-$branch-$arch-$machine.log";
+    }
+
+    if (!@ARGV) {
+	usage();
+    }
+
+    # Find out what we're expected to do
+    foreach my $cmd (@ARGV) {
+	if (!exists($cmds{$cmd})) {
+	    error("unrecognized command: '$cmd'");
+	}
+	$cmds{$cmd} = 1;
+    }
+
+    # Take control of our sandbox
+    if ($sandbox !~ m|^(/[\w/-]+)$|) {
+	error("invalid sandbox directory");
+    }
+    $sandbox = "$1/$branch/$arch/$machine";
+    make_dir($sandbox)
+	or error("$sandbox: $!");
+    my $lockfile = open_locked("$sandbox/lock", O_RDWR|O_CREAT);
+    if (!defined($lockfile)) {
+	error("unable to lock sandbox");
+    }
+    truncate($lockfile, 0);
+    print($lockfile "$$\n");
+
+    # Open logfile
+    open(STDIN, '<', "/dev/null")
+	or error("/dev/null: $!\n");
+    if ($logfile !~ m|([\w./-]+)$|) {
+	error("invalid log file name");
+    }
+    $logfile = $1;
+    logstage("logging to $logfile");
+    open(STDOUT, '>', $logfile)
+	or error("$logfile: $!");
+    open(STDERR, ">&STDOUT");
+    $| = 1;
+    logstage("starting $branch tinderbox run for $arch/$machine");
+    $SIG{__DIE__} = \&sigdie;
+    $SIG{__WARN__} = \&sigwarn;
+
+    # Clean up remains from old runs
+    if ($clean) {
+	logstage("cleaning up sandbox");
+	remove_dir("$sandbox/src")
+	    or error("unable to remove old source directory");
+	remove_dir("$sandbox/obj")
+	    or error("unable to remove old object directory");
+	make_dir("$sandbox/obj")
+	    or error("$sandbox/obj: $!");
+    }
+
+    # Check out new source tree
+    if ($update) {
+	cd("$sandbox");
+	logstage("checking out sources");
+	my @cvsargs = (
+	    "-f",
+	    "-R",
+	    $verbose ? "-q" : "-Q",
+	    "-d$repository",
+        );
+	if (-d "$sandbox/src") {
+	    push(@cvsargs, "update", "-Pd");
+	} else {
+	    push(@cvsargs, "checkout", "-P");
+	};
+	push(@cvsargs, "-r$branch")
+	    if defined($branch);
+	push(@cvsargs, "-D$date")
+	    if defined($date);
+	push(@cvsargs, "src");
+	spawn('/usr/bin/cvs', @cvsargs)
+	    or error("unable to check out the source tree");
+    }
+
+    # Prepare environment for make(1);
+    cd("$sandbox/src");
+    %ENV = (
+	'PATH'			=> "/usr/bin:/usr/sbin:/bin:/sbin",
+
+	'__MAKE_CONF'		=> "/dev/null",
+	'MAKEOBJDIRPREFIX'	=> "$sandbox/obj",
+
+	'TARGET_ARCH'		=> $arch,
+	'TARGET_MACHINE'	=> $machine,
+
+	'CFLAGS'		=> "-O -pipe",
+	'NO_CPU_CFLAGS'		=> "YES",
+	'COPTFLAGS'		=> "-O -pipe",
+	'NO_CPU_COPTFLAGS'	=> "YES",
+
+	'MAKE_KERBEROS4'	=> "YES",
+	'MAKE_KERBEROS5'	=> "YES",
+    );
+
+    # Build the world
+    if ($cmds{'world'}) {
+	logstage("building world");
+	make('buildworld')
+	    or error("failed to build world");
+    }
+
+    # Build GENERIC if requested
+    if ($cmds{'generic'}) {
+	logstage("building generic kernel");
+	$ENV{'KERNCONF'} = "GENERIC";
+	spawn('/usr/bin/make', 'buildkernel')
+	    or error("failed to build generic kernel");
+    }
+
+    # Build LINT if requested
+    if ($cmds{'lint'}) {
+	logstage("building lint kernel");
+	cd("$sandbox/src/sys/$machine/conf");
+	make('LINT')
+	    or error("failed to generate lint config");
+	cd("$sandbox/src");
+	$ENV{'KERNCONF'} = "LINT";
+	spawn('/usr/bin/make', 'buildkernel')
+	    or error("failed to build lint kernel");
+    }
+
+    # Exiting releases the lock file
+    logstage("tinderbox run completed");
+    exit(0);
+}