#!/usr/bin/perl
#
#   repair - report Debian bugs
#   Copyright (C) 1995  Richard Kettlewell
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

$repairversion = "0.1";

require '/usr/lib/repair.pl';

$config = "/etc/repair.conf";	# config filee
$expert = 0;			# expert mode
$admin = "root";		# local administratpr
$bugs = "debian-bugs\@pixar.com"; # global bugs address
$lib = "/var/lib/dpkg";		# dpkg library databases
$global = 0;			# is problem global or local?
$libc = "/lib/libc.so.4";	# filename for libc
chop($me = `whoami`);		# who is doing this?

# something to read

print <<EOF;
    Repair version 0.1, Copyright (C) 1995 Richard Kettlewell
    Repair comes with ABSOLUTELY NO WARRANTY
    This is free software, and you are welcome to redistribute it
    under certain conditions; see /usr/doc/copyright/GPL for details.

EOF

# read a config file

open(CONFIG, "<$config") && do {
    while(<CONFIG>)
    {
	chop;
	(/^\#/ || /^$/) && next;
	/(\S+)\s+(\S*)/;
	($opt, $arg) = ($1, $2);
	$opt =~ /^expert$/ && do {
	    $expert = 1;	# expert mode - assume user is clueful
	    next;
	};
	$opt =~ /^admin$/ && do {
	    $admin = $arg;	# local admin address
	    next;		# (maybe it's not root)
	};
	$opt =~ /^bugs$/ && do {
	    $bugs = $arg;	# debian-bugs submission address
	    next;		# (in case it changes)
	};
	$opt =~ /^global$/ && do {
	    $global = 1;	# allow sending to debian-bugs?
	    next;
	};
    }
    close CONFIG;
};

# have a look at the command line

foreach(@ARGV)
{
    /^--expert$/ && do {
	$expert = 1;		# expert mode from command line
	next;
    };
    /^--sanity$/ && do {
	$sanity_only = 1;	# just sanity check the package
	next;
    };
    /^--help$/ && do {
	&usage();
	exit 0;
    };
    /^--global$/ && do {
	$global = 1;		# allow mailing to debian-bugs
	next;
    };
    /^[^-]/ && do {
	defined($package) && do {
	    &usage();
	    exit 1;
	};
	$package = $_;		# specify a package
    };
}

$expert || ($global = 0);	# only experts want to send mail to debian-bugs

(!$global && $me eq $admin) && do {
    print "*** You haven't read and understood the manual for repair.\n";
    print "*** Go and do so now - have a look in /usr/doc.\n";
    exit 1;
};

# maybe we just want to sanity check a package's config files

if($sanity_only)
{
    defined($package) || do {
	&usage();
	exit 1;
    };
    if(-x "$lib/info/$package.bug") 
    {
	$type = int(system("$lib/info/$package.bug --sanity") / 256);
	($type == $BUG_OK) && exit 0;
	exit 1;
    }
    print "Package $package has no sanity checking script\n";
    exit 0;
}

# make sure we have a package to work with

defined($package) || do {
    print "What package is the problem with?\n> ";
    chop($package = <STDIN>);
};

# find out about it
# probably ought to go through dpkg to get this information...

open(STATUS, "<$lib/status")
    || die "$lib/status: $!";
while(<STATUS>)
{
    chop;
    /package:\s+/i && ($found_package = $');
    /version:\s+/i && ($version = $');
    /package_revision:\s+/i && ($revision = $');
    /^$/ && ($found_package eq $package) && last;
}
close STATUS;

($package eq $found_package) || do {
    print "Can't find anything about a package called $package\n";
    exit 1;
};

(defined $version) || die "can't find version for $package\n";
(defined $version) || die "can't find revision for $package\n";

# let the user know what we found

print "Package: $package\nVersion: $version-$revision\n\n";

# sanity check config files

@insanity = ();

if(-x "$lib/info/$package.bug") 
{
    print "Sanity checking $package...\n";
    $status = int(system("$lib/info/$package.bug --sanity /tmp/$$") / 256);
    if($status != $BUG_OK)
    {
	open(SANITY, "</tmp/$$") && do {
	    @insanity = <SANITY>;
	    close SANITY;
	    unlink "/tmp/$$";
	};
    }
}

# sanity check user :-)

@user = ();

if(-x "$lib/info/$package.bug") 
{
    $status = int(system("$lib/info/$package.bug --user /tmp/$$") / 256);
    if($status != $BUG_OK)
    {
	open(USER, "</tmp/$$")
	    || die "/tmp/$$: $!";
	@user = <USER>;
	close USER;
	unlink "/tmp/$$";
    }
    if($global && $status eq $BUG_USER)
    {
	print <<EOF;
This is almost certainly a local configuration or installation error, not a
Debian bug.  If you intend to report it as a bug in $package,
please be very sure that that is where the problem is.
		
EOF
        $global = 0;
    }
}

# find out what the user thinks is wrong

print "Please enter a one-line description of your problem:\n> ";
chop($subject = <STDIN>);

# build up a bug report

$report = "$ENV{'HOME'}/.bugreport";

open(OUT, ">$report")
    || die "$report: $!";

print OUT "From: $me\@", `cat /etc/mailname`;
print OUT "To: ", $global ? $bugs : $admin, "\n";
print OUT "Subject: $subject\n";
print OUT "\n";
if(!$global)
{
    print OUT <<EOF;
This message was partially generated by repair $repairversion, and
should be checked to see if it is a site-local problem or something
appropriate to debian-bugs.  In the latter case, it should be
forwarded to $bugs.

EOF
}
print OUT "Package: $package\n";
print OUT "Version: $version-$revision\n";
print OUT "Libc: ", readlink($libc), "\n";
print OUT "Kernel etc: ", `uname -a`;
print OUT "Reporter: repair $repairversion\n";
print OUT "\n";
print OUT @insanity;
print OUT @user;

close OUT;

# get a more detailed description of what the user thinks is wrong

print <<EOF;

I've created the first half of your bug report, now you should enter a
fuller description of the problem.

EOF

# fix up editor

($editor = $ENV{'VISUAL'})
    || ($editor = $ENV{'EDITOR'})
    || do {
	print "Please enter the name of an editor:\n";
	chop($editor = <STDIN>);
    };

# fix up pager
# we add some options to less to make it do the right thing for us

($pager = $ENV{'PAGER'}) || ($pager = "more");
($pager =~ /less/) && ($pager .= " -EMSX");

print "Hit RETURN to continue...\n";
$_ = <STDIN>;

# edit loop

$action = "edit";
while($action ne "send" && $action ne "abort")
{
    ($action eq "edit") && system("$editor $report");
    ($action eq "list") && system("$pager $report");
    $action = undef;
    while(!defined($action))
    {
	print "(S)end, (L)ist, (E)dit or (A)bort? ";
	chop($_ = <STDIN>);
	/^s/i && ($action = "send");
	/^e/i && ($action = "edit");
	/^l/i && ($action = "list");
	/^a/i && ($action = "abort");
    }
}

# send the message or whatever

($action eq "send") && do {
    system("/usr/lib/sendmail -t <$report");
    print "Sent bug report\n";
};

($action eq "abort") && do {
    print "Aborted bug report\n";
    print "A copy of your message may be found in $report\n";
};

sub usage
{
    print <<EOF;
Usage:-

    bugs [<package>]
    bugs --sanity <package>

    --sanity        Sanity check configuration files
                    (If the package supports it)
EOF
}
