#!/usr/pkg/bin/perl
# $Id: adjustkernel,v 1.4 2005/02/28 00:48:52 hubertf Exp $
#
# Copyright (c) 2004,2005 Hubert Feyrer <hubertf@NetBSD.org>,
#		          Martin Laubach <mjl@NetBSD.org>
# 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. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#        This product includes software developed by 
#        Hubert Feyrer <hubertf@NetBSD.org> and
#        Martin Laubach <mjl@NetBSD.org>
# 4. Neither the name of authors nor the names of any
#    contributors may be used to endorse or promote products derived
#    from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHORS 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 FOUNDATION 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.
#


use strict;
use Getopt::Long;

#--------------------------------------------------------------------------
sub findInDmesg($$);

#--------------------------------------------------------------------------
my $kernel;
my $outname;
my $debug = 0;
my $remove = 0;
my $mesg;

die "Invalid command line" unless GetOptions(
	'debug+'		=> \$debug,
	'file=s'		=> \$kernel,
	'outfile=s'	=>	\$outname,
	'remove+'	=> \$remove,
	'mesg=s'		=> \$mesg
	);

$kernel = shift(@ARGV)
    unless $kernel;

###########################################################################

die "Usage: $0 [-dmor] [--debug] [--mesg dmesg-file]\n".
    "\t\t [--outfile new-config][--remove] kernel-config\n" unless $kernel;

$| = 1 if $debug;

if($outname)
	{
	close STDOUT;
	open STDOUT, "> $outname" or die "Cannot write $outname: $!";
	}

my @dmesg;

if($mesg)
	{
	open DMESG, "< $mesg" or die "Cannot read $mesg: $!";
	@dmesg = <DMESG>;
	close DMESG;
	}
else
	{
	@dmesg = `dmesg`;
	}

@dmesg = grep /^\s*\w+\s+at\s+\w+/, @dmesg;

#--------------------------------------------------------------------------
open(K,"$kernel") or die "Cannot read $kernel: $!";
while (<K>)
	{
	chomp;
	if (/^\s*#/)
		{ # Already commented out
		# Nothing
		}
	elsif (/(\S*)\s+at\s+(\S*)(\s*.*)$/)
		{
		my ( $dev, $where, $comment ) = ( $1, $2, $3 );

		print STDERR "#>> Have? <$dev> at <$where><$comment>\n" if $debug;

		# Deal with inconsistencies
		$where = '\w+\d' if $where =~ /^mii/o;

		# Expand wildcards
		my $gdev=$dev;
		if ($dev =~ /[?*]$/o)
			{
			$gdev="$`\\d";
			}

		my $gwhere = $where;
		if ($where =~ /[?*]$/o)
			{
			$gwhere="$`\\d";
			}

		my $spat = "^${gdev}\\s+at\\s+${gwhere}";
		print STDERR "#>>   ? $spat\n" if $debug;

		my $l = findInDmesg(\@dmesg, "^${gdev}\\s+at\\s+${gwhere}");
		if (! $l)
			{
			if ($dev !~ /mainbus/)
				{	# inconsistent in dmesg, never comment out mainbus at something
				next if $remove;

				print "#(# ";
				}
			}
		}

	print "$_\n";
	}
close(K);

# Mention what we didn't find.
foreach (@dmesg)
	{
	print "# NOTE: NoMatch: $_";
	}

exit 0;

#--------------------------------------------------------------------------
sub findInDmesg($$)
	{
	my ( $dref, $pattern ) = @_;

	my @r = grep /$pattern/, @$dref;

	# We matched it once, so remove it from dmesg.
	# Ie. we match tr0 at isa once, but not tr* at isa later on
	@$dref = grep !/$pattern/, @$dref;

	print STDERR "#>> Have! @r" if @r && $debug;

	return scalar(@r) ? $r[0] : undef;
	}

#--------------------------------------------------------------------------

