#!/usr/bin/perl -w
#
# Pre-config tool. This tool can be pointed at a number of .deb files
# that have not yet been installed. It extracts the confmodules and templates
# from them and asks any necessary questions, storing the results in the
# database for later use.

# This program may be running from apt. If so, if it fails, apt is going to
# fail as well, which will make it hard for people to fix whatever the failure
# was. One thing someone encountered was perl failing to install. Apt then
# was re-run with perl unpacked and not configured, and modules weren't
# able to be loaded. As a sanity check, detect that case. If found, exit with
# an error message, but a return code of 0 so apt continues.
BEGIN {
	eval qq{
		use strict;
		use Debian::DebConf::ConfigDb;
		use Debian::DebConf::Config;
		use Debian::DebConf::AutoSelect;
		use Debian::DebConf::Version;
	};
	if ($@) {
		print STDERR "debconf: Perl may be unconfigured ($@) -- aborting\n";
		exit 0;
	}
}

# In apt mode, need unbuffered output.
$|=1;

# Parse command line. I don't use Getopt::Long since it's not in base.
my @debs;
my $apt='';
for (my $x=0; $x < @ARGV;) {
	$_=$ARGV[$x++];
	
	if ($_ eq '--apt') {
		$apt=1;
	}
	elsif (/^-(?:f|-frontend=)(.*)/) {
		Debian::DebConf::Config::frontend($1);
	}
	elsif (/^-(?:f|-frontend)$/) {
		Debian::DebConf::Config::frontend($ARGV[$x++]);
	}
	elsif (/^-(?:p|-priority=)(.*)/) {
		Debian::DebConf::Config::priority($1);
	}
	elsif (/^-(?:p|-priority)$/) {
		Debian::DebConf::Config::priority($ARGV[$x++]);
	}
	elsif (/^-(\w+)/) {
		print STDERR "Unknown option: $1\n";
	}
	else {
		push @debs, $_;
	}
}
@ARGV=();

# If running from apt, read package filenames on stdin.
if ($apt) {
	while (<>) {
		chomp;
		push @debs, $_ if length $_;
	}
	exit unless @debs;
	
	# We have now reached the end of the file on stdin.
	# Future reads from stdin should get input from the user, so re-open.
        open (STDIN, "/dev/tty") ||
		(print STDERR "dpkg-preconfigure: unable to re-open stdin: $!\n", exit 0);

	# Since we are running from apt, we will be preconfiguring some
	# packages prior to installing them. If the user has debconf configured
	# to re-ask seen questions, they will see the questions twice --
	# once when the package is preconfigured, and once when it is installed
	# to avoid that, turn off reasking of questions for the lifetime of
	# this program. The user will thus see the questions only once, when
	# the package is actually installed.
	# This is a hack, but it's the best I can do.
	Debian::DebConf::Config::showold('false');
}

# Load up previous state information.
Debian::DebConf::ConfigDb::loaddb(Debian::DebConf::Config::dbdir());

my $frontend=Debian::DebConf::AutoSelect::frontend();

# Caches package names so they are only looked up once.
my %packages;

# Packages that have templates
my %todo;

# Make two passes -- first load all templates, then run all             
# confmodules. 

foreach my $x (0..$#debs) {
	# Display a little progress indicator similar to what apt uses.
	# This is mostly for showing something is going on during huge
	# upgrades.
	if ($apt) {
		print "\r".(int( ($x+1) / ($#debs+1) * 100)).
			"% [Scanning packages]";
	}

	# See if there are any templates in this deb.
	open (TEMPLATES, "dpkg --info $debs[$x] templates 2>/dev/null |");
	if (! eof(TEMPLATES)) {
		# Now a sanity check: does this package depend
		# on a newer version of debconf than the current
		# version? If so, do nothing to prevent upgrade breaks.
		# The configuration of the package will still happen
		# when its postinst runs.
		#
		# This will also figure out the package name, since
		# that information is needed later.
		my $ok=1;
		open (INFO, "dpkg --info $debs[$x] |");
		while (<INFO>) {
			# Check for versioned debconf dependancy or
			# pre-dependancy, store relation in $1, depended-upon
			# version in $2.
			#
			# NOTE: if there are two debconf dependancies on a
			# line, this only looks at the first
			if (/^ (?:Pre-)?Depends:\s+.*?debconf\s+\(\s*([><=]*)\s+(.*?)\s*\)/i) {
				if (system('dpkg', '--compare-versions', $Debian::DebConf::Version::version, $1, $2) / 256 != 0) {
					$ok='';
				}
			}
			elsif (/^ Package:\s+(.*)/i) {
				$packages{$debs[$x]}=$1;
			}
		}
		close INFO;
	
		if ($ok) {
			# There are templates, so we need to continue
			# with other expensive stuff.
			$todo{$debs[$x]}=1;
			# Process the templates.
			# I want to slurp whole templates.
			local $/="\n\n";
			while (<TEMPLATES>) {
				Debian::DebConf::ConfigDb::loadtemplatedata($_, $packages{$debs[$x]});
			}
		}
	}	
	close TEMPLATES;
}

# Clear progress output.
if ($apt) {
	print "\r". ' ' x 30 . "\r";
}
my $runconfig='';

foreach my $deb (@debs) {
	# Check to see if this deb had any templates. If not, we skip
	# it as an optimization. (It's very unlikely it has any config
	# and if it does, the postinst will run it.)
	next unless $todo{$deb};

	# Check to see if this deb has a confmodule in it. If not,
	# we will skip it. If so, we need to save the confmodule
	# to disk so it can be run.
	open (IN, "dpkg --info $deb config 2>/dev/null |") or
		die "Unable to spawn dpkg: $!";
	
	next if eof(IN);
	
	if ($apt && ! $runconfig) {
		$runconfig=1;
		print "Configuring packages ...\n"
	}

	my $script=Debian::DebConf::Config::tmpdir()."/config.$$";
	open (OUT, ">$script") or die "$script: $!";
	print OUT <IN>; # TODO: optimize.
	close IN;
	close OUT;
	chmod(0755, $script) or 
		die "Can't chmod: $!";

	$frontend->default_title($packages{$deb});

	# Start up the confmodule, passing in the package version.
	my $confmodule=Debian::DebConf::AutoSelect::confmodule($script,
		'configure', getversion($packages{$deb}));

	# Make sure any questions created are owned by the correct package.
	$confmodule->owner($packages{$deb});

	# Talk to it until it is done.
	1 while ($confmodule->communicate);

	# I could just exit, but it's good to be robust so 
	# other packages can still be configured and installed.
	if ($confmodule->exitcode > 0) {
		print STDERR "$packages{$deb} failed to configure, with exit code ".$confmodule->exitcode."\n";
	}

	unlink $script;
}

# Save state.
Debian::DebConf::ConfigDb::savedb(Debian::DebConf::Config::dbdir());

# Pass a package name, and the version of that package is returned.
#
# The function in this block deals with the dpkg status file and is
# memoized. I parse the dpkg status file the first time it's called and
# return all else from a cache. I probably need to know the versions of
# several packages that are being installed, and calling dpkg -s for each
# would be unbearably slow. Since this program should be in dpkg anyway,
# I have few compunctions about parsing the file directly.
{
	my $haveversions='';
	my %versions;
	
	sub getversion {
		my $package=shift;
		
		if ($haveversions) {
			return $versions{$package} if defined $versions{$package};
			return ''; # not installed
		}

		{
			local $/="\n\n";
			open (STATUS, "</var/lib/dpkg/status");
			while (<STATUS>) {
				my ($package)=m/Package:\s*(.*?)\n/;
				($versions{$package})=m/Version:\s*(.*?)\n/;
				if (! defined $versions{$package}) {
					$versions{$package}='';
				}
			}
			close STATUS;
		}	
		$haveversions=1;
		return $versions{$package} if defined $versions{$package};
		return ''; # not installed
	}
}
