#!/usr/bin/perl -w

=head1 NAME

dpkg-reconfigure - reconfigure an already installed package

=head1 SYNOPSIS

 dpkg-reconfigure [options] packages

=head1 DESCRIPTION

B<dpkg-reconfigure> reconfigures packages after they have already been
installed. Pass it the names of a package or packages to reconfigure.

This has the same effect as re-installing the package, basically. I hope
one day this will be called by dpkg --reconfigure 

=head1 OPTIONS

=over 4

=item B<-f>I<type>, B<--frontend=>I<type>

Select the frontend to use. The default frontend can be permanently changed
by:

 dpkg-reconfigure debconf

Note that if you normally have debconf set to use the noninteractive
frontend, dpkg-reconfigure will use the dialog frontend instead, so you
actually get to reconfigure the package.

=item B<-p>I<value>, B<--priority=>I<value>

Specify the minimum priority of question that will be displayed.
dpkg-reconfigure normally shows low priority questions no matter what your
default priority is.

=item B<--all>

Reconfigure all installed packages that use debconf. Warning: this may take
a long time.

=item B<-u>, B<--unseen-only>

By default, all questions are shown, even if they have already been
answered. If this parameter is set though, only questions that have not yet
been seen will be asked.

=item B<--force>

Force dpkg-reconfigure to reconfigure a package even if the package is in an
inconsistent or broken state. Use with caution.

=item B<-h>, B<--help>

Display usage help.

=back

=cut

=head1 SEE ALSO

L<debconf(8)>

=cut

my $infodir="/var/lib/dpkg/info";

use strict;
use Debconf::Db;
use Debconf::Gettext;
use Debconf::Template;
use Debconf::Config;
use Debconf::AutoSelect qw(:all);
use Debconf::Log qw(:all);

if ($> != 0) {
	print STDERR "$0 ".gettext("must be run as root")."\n";
	exit 1;
}

Debconf::Db->load;

# Default to low priority.
Debconf::Config->priority('low');

my $unseen_only=0;
my $all=0;
my $force=0;
Debconf::Config->getopt( # TODO: i18n this? What's the best way to break it up?
qq{Syntax: dpkg-reconfigure [options] packages
  -a,  --all			Reconfigure all packages.
  -u,  --unseen-only		Show only not yet seen questions.
       --force			Force reconfiguration of broken packages.},
	"all|a"			=> \$all,
	"unseen-only|u"		=> \$unseen_only,
	"force"			=> \$force,
);

# If the frontend is noninteractive, change it temporarily to dialog.
if (Debconf::Config->frontend eq 'Noninteractive') {
	Debconf::Config->frontend('Dialog');
}

my $frontend=make_frontend();

unless ($unseen_only) {
	# Make the frontend show questions even if the user has already seen
	# them. Since this is a reconfigure program, they may want to change
	# their choices.
	Debconf::Config->showold('true');
}

my @packages;
if ($all) {
	@packages=allpackages();
	exit unless @packages;
}
else {
	@packages=@ARGV;
	if (! @packages) {
		print STDERR "$0: ".gettext("please specify a package to reconfigure")."\n";
		exit 1;
	}
}

foreach my $pkg (@packages) {
	# Set default title.
	$frontend->default_title($pkg);

	# Get the package version. Also check to make sure it is installed.
	$_=`dpkg --status $pkg`;
	my ($version)=m/Version: (.*)\n/;
	my ($status)=m/Status: (.*)\n/;
	if (! $force && (! defined $status || $status !~ m/ ok installed$/)) {
		print STDERR "$0: ".sprintf(gettext("%s is not fully installed"), $pkg)."\n";
		exit 1;
	}
	
	# Load up templates just in case they arn't already.
	Debconf::Template->load("$infodir/$pkg.templates", $pkg)
		if -e "$infodir/$pkg.templates";

	# Run config, and postinst scripts in sequence, with args.
	# Do not run postrm, because the postrm can depend on the package's
	# files actually being gone already.
	foreach my $info (['config',   'reconfigure', $version],
			  ['postinst', 'configure',   $version]) {
		my $script=shift @$info;
		next unless -x "$infodir/$pkg.$script";

		my $is_confmodule='';

		if ($script ne 'config') {
			# Test to see if the script uses debconf.
			open (IN, "<$infodir/$pkg.$script");
			while (<IN>) {
				if (/confmodule/i) {
					$is_confmodule=1;
					last;
				}
			}
			close IN;
		}
		
		if ($script eq 'config' || $is_confmodule) {
			# Start up the confmodule.
			my $confmodule=make_confmodule(
				"$infodir/$pkg.$script", @$info);
	
			# Make sure any questions the confmodule registers are owned
			# by this package.
			$confmodule->owner($pkg);
		
			# Talk to it until it is done.
			1 while ($confmodule->communicate);
	
			exit $confmodule->exitcode if $confmodule->exitcode > 0;
		}
		else {
			# Not a confmodule, so run it as a normal script.
			# Since it might run other programs that do use
			# debconf, checkpoint the current database state
			# and re-initialize it when the script finishes.
			Debconf::Db->save;
						
			$ENV{DEBIAN_HAS_FRONTEND}='';
			my $ret=system("$infodir/$pkg.$script", @$info);
			if (int($ret / 256) != 0) {
				exit int($ret / 256);
			}
			$ENV{DEBIAN_HAS_FRONTEND}=1;
			
			Debconf::Db->load;
		}
	}
}

$frontend->shutdown;

Debconf::Db->save;

# Returns a list of all installed packages.
sub allpackages {
	my @ret;
	local $/="\n\n";
	
	open (STATUS, "</var/lib/dpkg/status")
		|| die sprintf(gettext("Cannot read status file: %s"), $!);
	while (<STATUS>) {
		push @ret, $1
			if m/Status:\s*.*\sinstalled\n/ && m/Package:\s*(.*)\n/;
	}
	close STATUS;

	return sort @ret;
}

=head1 AUTHOR

Joey Hess <joey@kitenet.net>

=cut
