Index: head/tools/tools/tinderbox/tbmaster.1
===================================================================
--- head/tools/tools/tinderbox/tbmaster.1	(revision 120985)
+++ head/tools/tools/tinderbox/tbmaster.1	(revision 120986)
@@ -1,230 +1,235 @@
 .\"-
 .\" 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.
 .\" 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 AND CONTRIBUTORS ``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 OR CONTRIBUTORS 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$
 .\"
-.Dd August 1, 2003
+.Dd October 10, 2003
 .Dt TBMASTER 1
 .Os
 .Sh NAME
 .Nm tbmaster
 .Nd manage tinderbox runs
 .Sh SYNOPSIS
 .Nm
 .Op options
 .Sh DESCRIPTION
 The
 .Nm
 script manages
 .Xr tinderbox 1
 runs, generates log summaries, and mails out failure reports.
 .Pp
 The following options are recognized:
 .Bl -tag -width 12n
 .It Fl c Ar CONFIG , Fl -config Ns = Ns Ar CONFIG
 The name of the configuration to use.
 The default is the hostname minus the domain part.
 .It Fl d , Fl -dump
 Dumps the configuration and exits without running the tinderbox.
 .It Fl e Ar DIR , Fl -etcdir Ns = Ns Ar DIR
 The directory where configuration files are located.
 The default is
 .Pa $HOME/etc .
 .El
 .Ss Configuration
 The
 .Nm
 script uses named configurations located in individual files named for
 the setup they describe, with a
 .Pa .rc
 suffix.
 For instance, the
 .Dq snoosnoo
 configuration is contained in
 .Pa snoosnoo.rc .
 .Pp
 In addition,
 .Nm
 attempts to read
 .Pa default.rc
 before reading the actual configuration file; thus, that file may be
 used to specify default values shared by multiple configurations.
 .Pp
 The configuration consists of a list of single- or multiple-value
 variable assignments:
 .Bl -tag
 .It Va variable Ns = Ns Ar value
 .It Va variable Ns = Ns Ar value1 , Ar value 2, ...
 .El
 .Pp
 Whitespace around the equal sign and around the commas separating
 multiple values is optional.
 .Pp
 Blank lines are ignoed, as is anything following a hash sign
 .Pq Dq # .
 .Pp
 The following configuration variables are defined:
 .Bl -tag -width 12n
 .It ARCH
 .Pq Vt simple
 The architecture currently being built for.
 Read-only.
 .It BRANCH
 .Pq Vt simple
 The branch currently being built.
 Read-only.
 .It BRANCHES
 .Pq Vt multiple
 A list of source branches to build.
 The default value is
 .Dq CURRENT .
 .It COMMENT
 .Pq Vt single
 A terse comment describing the setup.
 No default value.
 .It DATE
 .Pq Vt single
 The date to use when checking out sources, or
 .Dq today
 for today's sources.
 If left undefined, the top of each branch is used.
 No default value.
 .It ENV
 .Pq Vt multiple
 A list of environment variables to pass to the
 .Xr tinderbox 1
 script.
 Each value is the name and value of an environment variable, separated
 by an equal sign
 .Pq Dq = .
 No default value.
 .It HOME
 .Pq Vt single
 The current user's home directory, as specified by the
 .Ev HOME
 environment variable.
 Note that it will not be defined unless it passes some simple sanity
 checks.
 Read-only.
+.It HOSTNAME
+.Pq Vt single
+The name of the host running the tinderbox.
+This is used for cosmetic purposes only.
+No default value.
 .It LOGDIR
 .Pq Vt single
 The location of the log directory.
 The default value is
 .Pa %%SANDBOX%%/logs .
 .It MACHINE
 .Pq Vt simple
 The machine currently being built for.
 Read-only.
 .It OPTIONS
 .Pq Vt multiple
 A list of additional options to pass to the
 .Xr tinderbox 1
 script.
 No default value.
 .It PATCH
 .Pq Vt single
 The file name (either absolute, or relative to the sandbox directory)
 of the patch to apply if the
 .Dq patch
 command is specified.
 No default value.
 .It PLATFORMS
 .Pq Vt multiple
 Which architectures and machines to build for.
 Each value is the name of an architecture, optionally followed by a
 forward slash
 .Pq Dq /
 and a machine name.
 If the machine name is not specified, it is assumed to be identical to
 the architecture name.
 The default value is
 .Dq i386 .
 .It RECIPIENT
 .Pq Vt single
 The address to which failure reports should be mailed.
 No default value.
 .It SANDBOX
 .Pq Vt single
 The location of the sandbox directory.
 The default value is
 .Pa /tmp/tinderbox .
 .It SENDER
 .Pq Vt single
 The envelope sender to use when mailing out failure reports.
 This should be a single email address.
 No default value.
 .It SUBJECT
 .Pq Vt single
 The subject to use on failure reports.
 The default value is
 .Dq Tinderbox failure on %%arch%%/%%machine%% .
 .It TARGETS
 .Pq Vt multiple
 A list of targets (commands) to specify to the
 .Xr tinderbox 1
 script.
 The default is
 .Dq world .
 .It TINDERBOX
 The location of the
 .Xr tinderbox(1)
 script.
 The default value is
 .Dq %%HOME%%/bin/tinderbox .
 .El
 .Pp
 Fields which are left undefined are filled in from the
 .Dq global
 setup.
 .Ss Variable Substitution
 All single-valued configuration variables are subject to variable
 substitution immediately before use.
 If a variable's value contains strings of the form
 .Va %%VAR%%
 or
 .Va %%var%% ,
 those strings are replaced with the values of the corresponding
 variables.
 The difference between the first and the second form is that the
 latter expands to lower-case.
 For instance,
 .Dq %%BRANCH%%
 might expand to
 .Dq RELENG_4
 while
 .Dq %%branch%%
 would expand to
 .Dq releng_4 .
 .Sh SEE ALSO
 .Xr perl 1 ,
 .Xr tinderbox 1
 .Sh AUTHORS
 .Nm
 was written by
 .An Dag-Erling Smørgrav Aq des@FreeBSD.org .
 .Sh BUGS
 - part of a complete breakfast!
Index: head/tools/tools/tinderbox/tbmaster.pl
===================================================================
--- head/tools/tools/tinderbox/tbmaster.pl	(revision 120985)
+++ head/tools/tools/tinderbox/tbmaster.pl	(revision 120986)
@@ -1,377 +1,380 @@
 #!/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 5.006_001;
 use strict;
 use Fcntl qw(:DEFAULT :flock);
 use POSIX;
 use Getopt::Long;
 
-my $VERSION	= "2.1";
+my $VERSION	= "2.2";
 my $COPYRIGHT	= "Copyright (c) 2003 Dag-Erling Smørgrav. " .
 		  "All rights reserved.";
 
 my $config;			# Name of current config
 my $dump;			# Dump configuration and exit
 my $etcdir;			# Configuration directory
 
 my %CONFIG = (
     'COMMENT'	=> '',
     'BRANCHES'	=> [ 'CURRENT' ],
     'PLATFORMS'	=> [ 'i386' ],
     'DATE'	=> '',
     'SANDBOX'	=> '/tmp/tinderbox',
+    'HOSTNAME'	=> '',
     'LOGDIR'	=> '%%SANDBOX%%/logs',
     'TARGETS'	=> [ 'update', 'world' ],
     'OPTIONS'	=> [],
     'PATCH'	=> '',
     'ENV'	=> [],
     'SENDER'	=> '',
     'RECIPIENT'	=> '',
     'SUBJECT'	=> 'Tinderbox failure on %%arch%%/%%machine%%',
     'TINDERBOX'	=> '%%HOME%%/tinderbox',
 );
 
 ###
 ### Perform variable expansion
 ###
 sub expand($);
 sub expand($) {
     my $key = shift;
 
     return "??$key??"
 	unless exists($CONFIG{uc($key)});
     return $CONFIG{uc($key)}
 	if (ref($CONFIG{uc($key)}));
     my $str = $CONFIG{uc($key)};
     while ($str =~ s/\%\%(\w+)\%\%/expand($1)/eg) {
 	# nothing
     }
     return ($key =~ m/[A-Z]/) ? $str : lc($str);
 }
 
 ###
 ### Read in a configuration file
 ###
 sub readconf($) {
     my $fn = shift;
 
     local *CONF;
     sysopen(CONF, $fn, O_RDONLY)
 	or return undef;
     my $line = "";
     my $n = 0;
     while (<CONF>) {
 	++$n;
 	chomp();
 	s/\s*(\#.*)?$//;
 	$line .= $_;
 	if (length($line) && $line !~ s/\\$/ /) {
 	    die("$fn: syntax error on line $n\n")
 		unless ($line =~ m/^(\w+)\s*=\s*(.*)$/);
 	    my ($key, $val) = (uc($1), $2);
 	    $val = ''
 		unless defined($val);
 	    die("$fn: unknown keyword on line $n\n")
 		unless (exists($CONFIG{$key}));
 	    if (ref($CONFIG{$key})) {
 		my @a = split(/\s*,\s*/, $val);
 		foreach (@a) {
 		    s/^\'([^\']*)\'$/$1/;
 		}
 		$CONFIG{$key} = \@a;
 	    } else {
 		$val =~ s/^\'([^\']*)\'$/$1/;
 		$CONFIG{$key} = $val;
 	    }
 	    $line = "";
 	}
     }
     close(CONF);
     return 1;
 }
 
 ###
 ### Report a tinderbox failure
 ###
 sub report($$$$) {
     my $sender = shift;
     my $recipient = shift;
     my $subject = shift;
     my $message = shift;
 
     local *PIPE;
     if (open(PIPE, "|-", "/usr/sbin/sendmail", "-i", "-t", "-f$sender")) {
 	print(PIPE "Sender: $sender\n");
 	print(PIPE "From: $sender\n");
 	print(PIPE "To: $recipient\n");
 	print(PIPE "Subject: $subject\n");
 	print(PIPE "Precedence: bulk\n");
 	print(PIPE "\n");
 	print(PIPE "$message\n");
 	close(PIPE);
     } else {
 	print(STDERR "[failed to send report by email]\n\n");
 	print(STDERR $message);
     }
 }
 
 ###
 ### Run the tinderbox
 ###
 sub tinderbox($$$) {
     my $branch = shift;
     my $arch = shift;
     my $machine = shift;
 
     $CONFIG{'BRANCH'} = $branch;
     $CONFIG{'ARCH'} = $arch;
     $CONFIG{'MACHINE'} = $machine;
 
     # Open log files: one for the full log and one for the summary
     my $logfile = expand('LOGDIR') . "/tinderbox-$branch-$arch-$machine";
     local (*FULL, *BRIEF);
     if (!open(FULL, ">", "$logfile.full.$$")) {
 	warn("$logfile.full.$$: $!\n");
 	return undef;
     }
     select(FULL);
     $| = 1;
     select(STDOUT);
     if (!open(BRIEF, ">", "$logfile.brief.$$")) {
 	warn("$logfile.brief.$$: $!\n");
 	return undef;
     }
     select(BRIEF);
     $| = 1;
     select(STDOUT);
 
     # Open a pipe for the tinderbox process
     local (*RPIPE, *WPIPE);
     if (!pipe(RPIPE, WPIPE)) {
 	warn("pipe(): $!\n");
 	unlink("$logfile.brief.$$");
 	close(BRIEF);
 	unlink("$logfile.full.$$");
 	close(FULL);
 	return undef;
     }
 
     # Fork and start the tinderbox
     my @args = @{$CONFIG{'OPTIONS'}};
+    push(@args, "--hostname=" . expand('HOSTNAME'))
+	if ($CONFIG{'HOSTNAME'});
     push(@args, "--sandbox=" . expand('SANDBOX'));
     push(@args, "--branch=$branch");
     push(@args, "--arch=$arch");
     push(@args, "--machine=$machine");
     push(@args, "--date=" . expand('DATE'))
 	if ($CONFIG{'DATE'});
     push(@args, "--patch=" . expand('PATCH'))
 	if ($CONFIG{'PATCH'});
     push(@args, @{$CONFIG{'TARGETS'}});
     push(@args, @{$CONFIG{'ENV'}});
     my $pid = fork();
     if (!defined($pid)) {
 	warn("fork(): $!\n");
 	unlink("$logfile.brief.$$");
 	close(BRIEF);
 	unlink("$logfile.full.$$");
 	close(FULL);
 	return undef;
     } elsif ($pid == 0) {
 	close(RPIPE);
 	open(STDOUT, ">&WPIPE");
 	open(STDERR, ">&WPIPE");
 	$| = 1;
 	exec(expand('TINDERBOX'), @args);
 	die("child: exec(): $!\n");
     }
 
     # Process the output
     close(WPIPE);
     my @lines = ();
     my $error = 0;
     my $summary = "";
     while (<RPIPE>) {
 	print(FULL $_);
 	if (/^TB ---/ || /^>>> /) {
 	    if ($error) {
 		$summary .= join('', @lines);
 		print(BRIEF join('', @lines));
 		@lines = ();
 		$error = 0;
 	    }
 	    $summary .= $_;
 	    print(BRIEF $_);
 	    @lines = ();
 	    next;
 	}
 	if (/^Stop in /) {
 	    $error = 1;
 	}
 	if (@lines > 10 && !$error) {
 	    shift(@lines);
 	    $lines[0] = "[...]\n";
 	}
 	push(@lines, $_);
     }
     close(RPIPE);
     if ($error) {
 	$summary .= join('', @lines);
 	print(BRIEF join('', @lines));
     }
 
     # Done...
     if (waitpid($pid, 0) == -1) {
 	warn("waitpid(): $!\n");
     } elsif ($? & 0xff) {
 	my $msg = "tinderbox caught signal " . ($? & 0x7f) . "\n";
 	print(BRIEF $msg);
 	print(FULL $msg);
 	$error = 1;
     } elsif ($? >> 8) {
 	my $msg = "tinderbox returned exit code " . ($? >> 8) . "\n";
 	print(BRIEF $msg);
 	print(FULL $msg);
 	$error = 1;
     }
     close(BRIEF);
     close(FULL);
 
     # Mail out error reports
     if ($error && $CONFIG{'RECIPIENT'}) {
 	my $sender = expand('SENDER');
 	my $recipient = expand('RECIPIENT');
 	my $subject = expand('SUBJECT');
 	report($sender, $recipient, $subject, $summary);
     }
 
     rename("$logfile.full.$$", "$logfile.full");
     rename("$logfile.brief.$$", "$logfile.brief");
 }
 
 ###
 ### Print a usage message and exit
 ###
 sub usage() {
 
     print(STDERR "This is the FreeBSD tinderbox manager, version $VERSION.
 $COPYRIGHT
 
 Usage:
   $0 [options] [parameters]
 
 Parameters:
   -c, --config=FILE             Configuration name
   -e, --etcdir=DIR              Configuration directory
 
 Report bugs to <des\@freebsd.org>.
 ");
     print(STDERR "usage: tbmaster\n");
     exit(1);
 }
 
 ###
 ### Main
 ###
 MAIN:{
     # Set defaults
     $ENV{'PATH'} = "/usr/bin:/usr/sbin:/bin:/sbin";
     $config = `uname -n`;
     chomp($config);
     $config =~ s/^(\w+)(\..*)?/$1/;
     if ($ENV{'HOME'} =~ m/^((?:\/[\w\.-]+)+)\/*$/) {
 	$CONFIG{'HOME'} = $1;
 	$etcdir = "$1/etc";
 	$ENV{'PATH'} = "$1/bin:$ENV{'PATH'}"
 	    if (-d "$1/bin");
     }
 
     # Get options
     {Getopt::Long::Configure("auto_abbrev", "bundling");}
     GetOptions(
 	"c|config=s"	        => \$config,
 	"d|dump"		=> \$dump,
 	"e|etcdir=s"		=> \$etcdir,
 	) or usage();
     if (@ARGV) {
 	usage();
     }
 
     if (defined($etcdir)) {
 	if ($etcdir !~ m/^([\w\/\.-]+)$/) {
 	    die("invalid etcdir\n");
 	}
 	$etcdir = $1;
 	chdir($etcdir)
 	    or die("$etcdir: $!\n");
     }
     readconf('default.rc');
     readconf("$config.rc")
 	or die("$config.rc: $!\n");
     $CONFIG{'CONFIG'} = $config;
     $CONFIG{'ETCDIR'} = $etcdir;
 
     if ($dump) {
 	foreach my $key (sort(keys(%CONFIG))) {
 	    printf("%-12s = ", lc($key));
 	    if (!defined($CONFIG{$key})) {
 		print("(undef)");
 	    } elsif (ref($CONFIG{$key})) {
 		print(join(", ", @{$CONFIG{$key}}));
 	    } else {
 		print($CONFIG{$key});
 	    }
 	    print("\n");
 	}
 	exit(0);
     }
 
     if (!length(expand('TINDERBOX')) || !-x expand('TINDERBOX')) {
 	die("Where is the tinderbox script?\n");
     }
 
     my $stopfile = expand('SANDBOX') . "/stop";
     foreach my $branch (@{$CONFIG{'BRANCHES'}}) {
 	foreach my $platform (@{$CONFIG{'PLATFORMS'}}) {
 	    if (-e $stopfile || -e "$stopfile.$config") {
 		die("stop file found, aborting\n");
 	    }
 	    my ($arch, $machine) = split('/', $platform, 2);
 	    $machine = $arch
 		unless defined($machine);
 	    if (-e "$stopfile.$arch" || -e "$stopfile.$arch.$machine") {
 		warn("stop file for $arch/$machine found, skipping\n");
 		next;
 	    }
 	    tinderbox($branch, $arch, $machine);
 	}
     }
 }